## Replication file for The Power of Compromise, Last updated 9-16-2020 by Ryan Brutger
## This analysis was run on  R version 3.6.1 (2019-07-05) -- "Action of the Toes" using
## MacBook Pro 2.8GHx Intel Core i7 using macOS Mojave version 10.14.6

## This R file contains the code necessary to replicate the analysis in the main text and the appendix.  

################# 1. Load libraries, load and clean data ##############

#First, set your working directory using the setwd() command:
setwd()

#Load required R packages (download first if necessary)
library(foreign)
library(ggplot2)
library(Hmisc)
library(ggplot2)
library(mediation)

load("exper1.rdata") # Experiment 1
load("exper2.rdata") # Experiment 2
load("exper3.rdata") # Experiment 3
load("exper4.rdata") # Experiment 4


## Audience cost effect for experiment 1 and 2 (full sample)
t.test(exper1$tot.approval[exper1$Strategy==3], 
       exper1$tot.approval[exper1$Strategy==1]) # p < 0.00
mean(exper1$tot.approval[exper1$Strategy==3 ]) - mean(exper1$tot.approval[exper1$Strategy==1]) 
# effect = -2.03

t.test(exper2$tot.approval[exper2$Strategy==3 & exper2$t2.c0.dum==1], 
       exper2$tot.approval[exper2$Strategy==1 & exper2$t2.c0.dum==1]) # p < 0.01
mean(exper2$tot.approval[exper2$Strategy==3 & exper2$t2.c0.dum==1]) - mean(exper2$tot.approval[exper2$Strategy==1 & exper2$t2.c0.dum==1]) 
# effect = -1.76

##
## Figure 1 with bootstrapped distributions of support
##

bootMean2 <- function(dat, dv="tot.approval", B=2000){
  bootResults <- matrix(NA, nrow=B, ncol=5)
  for (i in seq_len(B)){
    resample <- sample(1:nrow(dat),nrow(dat),replace=T)
    temp <- dat[resample,]
    dep.var <- eval(parse(text=paste("temp",dv,sep="$")))
    A <- mean(dep.var[which(temp$Strategy==1)], na.rm=TRUE)
    B <- mean(dep.var[which(temp$Strategy==3)], na.rm=TRUE)
    C <- mean(dep.var[which(temp$Strategy==4)], na.rm=TRUE)
    bootResults[i,1] <- (A)
    bootResults[i,2] <- (B)
    bootResults[i,3] <- (C)
    bootResults[i,4] <- (C-B)
    bootResults[i,5] <- (B-A)
    drop(list())
  }
  return(list(dv=dv, boot=bootResults, Audience.Cost=mean(bootResults[,5], na.rm=TRUE), Compromise.Effect=mean(bootResults[,4], na.rm=TRUE)))
}

## Experiment 1
## Subset data by Party of President
exper1.D <- subset(exper1[exper1$Pres_Party==1, ]) # Subset data for Democrat as President
exper1.R <- subset(exper1[exper1$Pres_Party==2, ]) # Subset data for Republican as President

set.seed(02138) 

SupportEx1 <- bootMean2(exper1, dv="tot.approval") 
SupportEx1D <- bootMean2(exper1.D, dv="tot.approval") 
SupportEx1R <- bootMean2(exper1.R, dv="tot.approval") 

B<-2000

# Density plots of Compromise vs Not Engage by by party of the president
dens <- data.frame(y=c(SupportEx1$boot[,2], SupportEx1$boot[,3], SupportEx1D$boot[,2], SupportEx1D$boot[,3], SupportEx1R$boot[,2], SupportEx1R$boot[,3]), samp=rep(rep(c("1. Full Study", "2. Democrat Pres.", "3. Republican Pres."), each=B*2),1), Treatment=rep(rep(c("Not Engage", "Compromise"), each=B),3))

# p-values and effects for figure:
effect <- data.frame(
  label = c("Effect=0.72", "Effect=0.67", "Effect=0.77"),
  samp   = c("1. Full Study", "2. Democrat Pres.", "3. Republican Pres."),
  x     = c(-.25, -.25, -.25),
  y     = c(3.3, 3.3, 3.3)
)

pvalue <- data.frame(
  label = c("p<0.01", "p=0.02", "p<0.01"),
  samp   = c("1. Full Study", "2. Democrat Pres.", "3. Republican Pres."),
  x     = c(-.25, -.25, -.25),
  y     = c(3, 3, 3)
)

#Overlapping density plot with alpha channels
dev.new(height=2, width=4.5)
p <- ggplot(dens, aes(x=y)) + geom_density(aes(fill=Treatment), alpha=0.35) + facet_grid(~ samp, scales="fixed") + 
  geom_text(size = 2.5, data = effect,mapping = aes(x = x, y = y, label = label)) +
  geom_text(size = 2.5, data = pvalue,mapping = aes(x = x, y = y, label = label)) +
  labs(x="Average Approval Score", y="Density") + theme_bw() + theme(axis.text.y=element_blank(), 
  axis.text=element_text(size=6),axis.ticks.y=element_blank(), legend.title = element_text(size=7.5),
  legend.text = element_text(size=7), legend.key.size = unit(.75,"line"),axis.title=element_text(size=7.5), strip.text = element_text(size = 6.5)) + geom_vline(xintercept=0, linetype=3, alpha=0.3) + scale_fill_grey() 

# Generate output for row 1 of Figure 1
print(p)
ggsave("ApprovExper1PresParty.pdf", width=4.5, height=2)

## Effects and p-values for Figure 1, Experiment 1

#Full Study
t.test(exper1$tot.approval[exper1$Comp==1], exper1$tot.approval[exper1$Not_Engage==1]) # p < 0.01
mean(exper1$tot.approval[exper1$Comp==1], na.rm=TRUE) - mean(exper1$tot.approval[exper1$Not_Engage==1], na.rm=TRUE) 
# effect = 0.72

#Dem President
t.test(exper1.D$tot.approval[exper1.D$Comp==1], exper1.D$tot.approval[exper1.D$Not_Engage==1]) # p = 0.02
mean(exper1.D$tot.approval[exper1.D$Comp==1], na.rm=TRUE) - mean(exper1.D$tot.approval[exper1.D$Not_Engage==1], na.rm=TRUE) 
# effect = 0.67

#Rep President
t.test(exper1.R$tot.approval[exper1.R$Comp==1], exper1.R$tot.approval[exper1.R$Not_Engage==1]) # p < 0.01
mean(exper1.R$tot.approval[exper1.R$Comp==1], na.rm=TRUE) - mean(exper1.R$tot.approval[exper1.R$Not_Engage==1], na.rm=TRUE) 
# effect = 0.77

#Full study - percent approving discussed in text
## Rescale dichatamous measure so results are in percent approving
exper1$supp2 <- exper1$supp * 100
exper2$supp2 <- exper2$supp * 100

#Experiment 1
t.test(exper1$supp2[exper1$Comp==1], exper1$supp2[exper1$Not_Engage==1]) # p < 0.01
mean(exper1$supp2[exper1$Comp==1], na.rm=TRUE) - mean(exper1$supp2[exper1$Not_Engage==1], na.rm=TRUE) 
# effect = 14.9%

#Experiment 2
t.test(exper2$supp2[exper2$Comp==1 & exper2$t2.c0.dum==1], exper2$supp2[exper2$Not_Engage==1 & exper2$t2.c0.dum==1]) # p < 0.00
mean(exper2$supp2[exper2$Comp==1 & exper2$t2.c0.dum==1], na.rm=TRUE) - mean(exper2$supp2[exper2$Not_Engage==1 & exper2$t2.c0.dum==1], na.rm=TRUE) 
# effect = 14.4%

## Experiment 2
## Subset data by Party of President and hold outcomes constant at 20% territory gained
exper2.D <- subset(exper2[exper2$Pres_Party==1 & exper2$t2.c0.dum==1, ]) # Subset data for Democrat as President
exper2.R <- subset(exper2[exper2$Pres_Party==2 & exper2$t2.c0.dum==1, ]) # Subset data for Republican as President

set.seed(02138)

SupportEx2 <- bootMean2(exper2, dv="tot.approval") 
SupportEx2D <- bootMean2(exper2.D, dv="tot.approval") 
SupportEx2R <- bootMean2(exper2.R, dv="tot.approval") 

B<-2000

# Density plots of Compromise vs Not Engage by ideology
dens <- data.frame(y=c(SupportEx2$boot[,2], SupportEx2$boot[,3], SupportEx2D$boot[,2], SupportEx2D$boot[,3], SupportEx2R$boot[,2], SupportEx2R$boot[,3]), samp=rep(rep(c("1. Full Study", "2. Democrat Pres.", "3. Republican Pres."), each=B*2),1), Treatment=rep(rep(c("Not Engage", "Compromise"), each=B),3))

# p-values and effects for figure:
effect <- data.frame(
  label = c("Effect=0.66", "Effect=0.46", "Effect=0.86"),
  samp   = c("1. Full Study", "2. Democrat Pres.", "3. Republican Pres."),
  x     = c(-.45, -.45, -.45),
  y     = c(4.9, 4.9, 4.9)
)

pvalue <- data.frame(
  label = c("p<0.01", "p=0.10", "p<0.01"),
  samp   = c("1. Full Study", "2. Democrat Pres.", "3. Republican Pres."),
  x     = c(-.45, -.45, -.45),
  y     = c(4.5, 4.5, 4.5)
)

#Overlapping density plot with alpha channels
dev.new(height=2, width=4.5)
p <- ggplot(dens, aes(x=y)) + geom_density(aes(fill=Treatment), alpha=0.35) + facet_grid(~ samp, scales="fixed") + 
  geom_text(size = 2.5, data = effect,mapping = aes(x = x, y = y, label = label)) +
  geom_text(size = 2.5, data = pvalue,mapping = aes(x = x, y = y, label = label)) +
  labs(x="Average Approval Score", y="Density") + theme_bw() + theme(axis.text.y=element_blank(), 
                                                                     axis.text=element_text(size=6),axis.ticks.y=element_blank(), legend.title = element_text(size=7.5),
                                                                     legend.text = element_text(size=7), legend.key.size = unit(.75,"line"), axis.title=element_text(size=7.5), strip.text = element_text(size = 6.5)) + geom_vline(xintercept=0, linetype=3, alpha=0.3) + scale_fill_grey() 
# Generate output for row 1 of Figure 1
print(p)
ggsave("ApprovExper2PresParty.pdf", width=4.5, height=2)

## Effects and p-values for Figure 1, Experiment 2

#Full Study
t.test(exper2$tot.approval[exper2$Comp==1 & exper2$t2.c0.dum==1], exper2$tot.approval[exper2$Not_Engage==1 & exper2$t2.c0.dum==1]) # p < 0.01
mean(exper2$tot.approval[exper2$Comp==1 & exper2$t2.c0.dum==1], na.rm=TRUE) - mean(exper2$tot.approval[exper2$Not_Engage==1 & exper2$t2.c0.dum==1], na.rm=TRUE) 
# effect = 0.66

#Dem President
t.test(exper2.D$tot.approval[exper2.D$Comp==1], exper2.D$tot.approval[exper2.D$Not_Engage==1]) # p = 0.10
mean(exper2.D$tot.approval[exper2.D$Comp==1], na.rm=TRUE) - mean(exper2.D$tot.approval[exper2.D$Not_Engage==1], na.rm=TRUE) 
# effect = 0.46

#Rep President
t.test(exper2.R$tot.approval[exper2.R$Comp==1], exper2.R$tot.approval[exper2.R$Not_Engage==1]) # p < 0.01
mean(exper2.R$tot.approval[exper2.R$Comp==1], na.rm=TRUE) - mean(exper2.R$tot.approval[exper2.R$Not_Engage==1], na.rm=TRUE) 
# effect = 0.86


##
## Figure 2
## Support for compromise conditional on ideology
##

## Subset data by respondent's ideology
#rename ideology variable for experiment 2
exper2$ideology <- exper2$ideol

bootMean1 <- function(dat, dv="tot.approval", B=2000){
  bootResults <- matrix(NA, nrow=B, ncol=5)
  for (i in seq_len(B)){
    resample <- sample(1:nrow(dat),nrow(dat),replace=T)
    temp <- dat[resample,]
    dep.var <- eval(parse(text=paste("temp",dv,sep="$")))
    A <- mean(dep.var[which(temp$ideology<3)], na.rm=TRUE)
    B <- mean(dep.var[which(temp$ideology>3)], na.rm=TRUE)
    C <- mean(dep.var[which(temp$Strategy==4)], na.rm=TRUE)
    bootResults[i,1] <- (A)
    bootResults[i,2] <- (B)
    bootResults[i,3] <- (C)
    bootResults[i,4] <- (C-B)
    bootResults[i,5] <- (B-A)
    drop(list())
  }
  return(list(dv=dv, boot=bootResults, Audience.Cost=mean(bootResults[,5], na.rm=TRUE), Compromise.Effect=mean(bootResults[,4], na.rm=TRUE)))
}

# Subset to just compromise treatment holding outcomes constant
exper1comp <- subset(exper1[exper1$Comp==1, ])
exper2comp <- subset(exper2[exper2$Compromise==1 & exper2$t2.c0.dum==1, ])

set.seed(02138)

Ex1SupportLC <- bootMean1(exper1comp, dv="tot.approval") 
Ex2SupportLC <- bootMean1(exper2comp, dv="tot.approval") 


dens <- data.frame(y=c(Ex1SupportLC$boot[,1], Ex1SupportLC$boot[,2], Ex2SupportLC$boot[,1], Ex2SupportLC$boot[,2]), samp=rep(rep(c("Experiment 1", "Experiment 2"), each=B*2),1), Treatment=rep(rep(c("Liberal", "Conservative"), each=B),2))

# p-velues and effects for figures
effect <- data.frame(
  label = c("Effect=0.85", "Effect=0.94"),
  samp   = c("Experiment 1", "Experiment 2"),
  x     = c(-.5, -.5),
  y     = c(2.2, 2.2)
)

pvalue <- data.frame(
  label = c("p=0.05", "p=0.01"),
  samp   = c("Experiment 1", "Experiment 2"),
  x     = c(-.5, -.5),
  y     = c(2.05, 2.05)
)

#Overlapping density plot with alpha channels
dev.new(height=2.5, width=4.5)
p <- ggplot(dens, aes(x=y)) + geom_density(aes(fill=Treatment), alpha=0.35) + facet_grid(~ samp, scales="fixed") + 
  geom_text(size = 2.5, data = effect,mapping = aes(x = x, y = y, label = label)) +
  geom_text(size = 2.5, data = pvalue,mapping = aes(x = x, y = y, label = label)) +
  labs(x="Average Approval Score", y="Density") + theme_bw() + theme(axis.text.y=element_blank(), 
                                                                     axis.text=element_text(size=6),axis.ticks.y=element_blank(), legend.title = element_text(size=7.5),
                                                                     legend.text = element_text(size=7), legend.key.size = unit(.75,"line"), strip.text = element_text(size = 7.5), axis.title=element_text(size=7.5)) + geom_vline(xintercept=0, linetype=3, alpha=0.3) + scale_fill_grey() 

# Generate output for Figure 2
print(p)
ggsave("LibConCompSuppEx1Ex2.pdf", width=4.5, height=2.5)

# Effects and p-values
#Experiment 1
t.test(exper1$tot.approval[exper1$Comp==1 & exper1$ideology<3], 
       exper1$tot.approval[exper1$Comp==1 & exper1$ideology>3]) # p = 0.05
mean(exper1$tot.approval[exper1$Comp==1 & exper1$ideology<3], na.rm=TRUE) - mean(exper1$tot.approval[exper1$Comp==1 & exper1$ideology>3], na.rm=TRUE) 
# effect = 0.85

#Experiment 2
t.test(exper2$tot.approval[exper2$Compromise==1 & exper2$t2.c0.dum==1 & exper2$ideology<3], 
       exper2$tot.approval[exper2$Compromise==1 & exper2$t2.c0.dum==1 & exper2$ideology>3]) # p = 0.01
mean(exper2$tot.approval[exper2$Compromise==1 & exper2$t2.c0.dum==1 & exper2$ideology<3]) - mean(exper2$tot.approval[exper2$Compromise==1 & exper2$t2.c0.dum==1 & exper2$ideology>3]) 
# effect = 0.94

# Difference in percent approving between liberals and conservatives
#Experiment 1
t.test(exper1$supp2[exper1$Comp==1 & exper1$ideology<3], 
       exper1$supp2[exper1$Comp==1 & exper1$ideology>3]) # p < 0.03
mean(exper1$supp2[exper1$Comp==1 & exper1$ideology<3], na.rm=TRUE) - mean(exper1$supp2[exper1$Comp==1 & exper1$ideology>3], na.rm=TRUE) 
# effect = 20.9%

#Experiment 2
t.test(exper2$supp2[exper2$Compromise==1 & exper2$t2.c0.dum==1 & exper2$ideology<3], 
       exper2$supp2[exper2$Compromise==1 & exper2$t2.c0.dum==1 & exper2$ideology>3]) # p = 0.01
mean(exper2$supp2[exper2$Compromise==1 & exper2$t2.c0.dum==1 & exper2$ideology<3]) - mean(exper2$supp2[exper2$Compromise==1 & exper2$t2.c0.dum==1 & exper2$ideology>3]) 
# effect = 22.4%


# Difference in percent approving by party discussed in the text
#Experiment 1
t.test(exper1$supp2[exper1$Comp==1 & exper1$polParty==1], 
       exper1$supp2[exper1$Comp==1 & exper1$polParty==2]) # p < 0.01
mean(exper1$supp2[exper1$Comp==1 & exper1$polParty==1], na.rm=TRUE) - mean(exper1$supp2[exper1$Comp==1 & exper1$polParty==2], na.rm=TRUE) 
# effect = 29.6%

#Experiment 2
t.test(exper2$supp2[exper2$Compromise==1 & exper2$t2.c0.dum==1 & exper2$polParty==1], 
       exper2$supp2[exper2$Compromise==1 & exper2$t2.c0.dum==1 & exper2$polParty==2]) # p = 0.06
mean(exper2$supp2[exper2$Compromise==1 & exper2$t2.c0.dum==1 & exper2$polParty==1]) - mean(exper2$supp2[exper2$Compromise==1 & exper2$t2.c0.dum==1 & exper2$polParty==2]) 
# effect = 19.1%

##
## Figure 3 - Approval of compromise and not engage based on territorial outcomes
## Plot of Compromise and Not Engage with different territorial outcomes

## Estimate Porposal Power with Party Match
## dummy for party-match
c.value <-qnorm(.95)

compr.tot.score.t2 <- mean(exper2$tot.approval[exper2$Strategy==4 & exper2$Territory==2])
se.compr.tot.score.t2 <- sqrt(var(exper2$tot.approval[exper2$Strategy==4 & exper2$Territory==2])/length(exper2$tot.approval[exper2$Strategy==4 & exper2$Territory==2])) 
ci.up.compr.tot.score.t2 <- compr.tot.score.t2   + se.compr.tot.score.t2 * c.value   
ci.low.compr.tot.score.t2 <- compr.tot.score.t2   - se.compr.tot.score.t2 * c.value

compr.tot.score.t3 <- mean(exper2$tot.approval[exper2$Strategy==4 & exper2$Territory==3])
se.compr.tot.score.t3 <- sqrt(var(exper2$tot.approval[exper2$Strategy==4 & exper2$Territory==3])/length(exper2$tot.approval[exper2$Strategy==4 & exper2$Territory==3])) 
ci.up.compr.tot.score.t3 <- compr.tot.score.t3   + se.compr.tot.score.t3 * c.value   
ci.low.compr.tot.score.t3 <- compr.tot.score.t3   - se.compr.tot.score.t3 * c.value

notengage.tot.score.t2 <- mean(exper2$tot.approval[exper2$Strategy==3 & exper2$Territory==2])
se.notengage.tot.score.t2 <- sqrt(var(exper2$tot.approval[exper2$Strategy==3 & exper2$Territory==2])/length(exper2$tot.approval[exper2$Strategy==3 & exper2$Territory==2])) 
ci.up.notengage.tot.score.t2 <- notengage.tot.score.t2   + se.notengage.tot.score.t2 * c.value   
ci.low.notengage.tot.score.t2 <- notengage.tot.score.t2   - se.notengage.tot.score.t2 * c.value

notengage.tot.score.t3 <- mean(exper2$tot.approval[exper2$Strategy==3 & exper2$Territory==3])
se.notengage.tot.score.t3 <- sqrt(var(exper2$tot.approval[exper2$Strategy==3 & exper2$Territory==3])/length(exper2$tot.approval[exper2$Strategy==3 & exper2$Territory==3])) 
ci.up.notengage.tot.score.t3 <- notengage.tot.score.t3   + se.notengage.tot.score.t3 * c.value   
ci.low.notengage.tot.score.t3 <- notengage.tot.score.t3   - se.notengage.tot.score.t3 * c.value


###

tot.app.prop.means<- c(compr.tot.score.t2, compr.tot.score.t3)
tot.app.prop.means.ci.up <-c(ci.up.compr.tot.score.t2, ci.up.compr.tot.score.t3)
tot.app.prop.means.ci.low <- c(ci.low.compr.tot.score.t2, ci.low.compr.tot.score.t3)

tot.app.prop.means.notengage <- c(notengage.tot.score.t2, notengage.tot.score.t3)
tot.app.prop.means.ci.up.notengage <-c(ci.up.notengage.tot.score.t2, ci.up.notengage.tot.score.t3)
tot.app.prop.means.ci.low.notengage <- c(ci.low.notengage.tot.score.t2, ci.low.notengage.tot.score.t3)

tot.app.prop.t.c.names <- c("Attacking Country Gained \n 20% Territory", "Attacking Country Gained \n 50% Territory")


## Side by side in one plot
pdf(file ="~/Dropbox/The Power of Compromise/World Politics/New WP Data and Figures 5-22-2020/Exper2_terr_comp_notengage_means.pdf", height = 4, width = 4.5)
par(mar=c(2,5,1,2))
plot(1:2, tot.app.prop.means , main = "", 
     ylab = "", xlab = "", cex.lab=1,
     ylim = c(-2, 1.65), xlim = c(0.75, 2.25), pch = 19, type = "p", xaxt="n", cex=1)
mtext("Average Approval Score", side=2, at=0, cex=.9, line=2.5)
abline(h=0, col="blue", lty=2)
for(i in 1:length(tot.app.prop.means)){
  lines(c(i,i), c(tot.app.prop.means.ci.up[i], tot.app.prop.means.ci.low[i]))
  mtext(tot.app.prop.t.c.names[i], side=1, at=i, 1.12,tot.app.prop.t.c.names[i], cex=.8)
}
points(1.15:2.15, tot.app.prop.means.notengage, pch=22, cex=1)
for(i in 1:length(tot.app.prop.means.notengage)){
  lines(c(i+.15,i+.15), c(tot.app.prop.means.ci.up.notengage[i], tot.app.prop.means.ci.low.notengage[i]))
}
text(2, 1.45, labels = "Compromise", cex=1)
text(1.99, 1.2, labels = "Not Engage", cex=1)
points(1.71, 1.45, pch=19, cex=1)
points(1.71, 1.2, pch=22, cex=1)
dev.off()

# Comparing compromise condition for 20% vs 50% territorial gain (discussed in text)
t.test(exper2$tot.approval[exper2$Strategy==4 & exper2$Territory==2], 
       exper2$tot.approval[exper2$Strategy==4 & exper2$Territory==3]) # p < 0.95
mean(exper2$tot.approval[exper2$Strategy==4 & exper2$Territory==2]) - mean(exper2$tot.approval[exper2$Strategy==4 & exper2$Territory==3]) 
# effect = -0.01

#Comparing not engage conditions for 20% vs 50% territorial gain (discussed in text)
t.test(exper2$tot.approval[exper2$Strategy==3 & exper2$Territory==2], 
       exper2$tot.approval[exper2$Strategy==3 & exper2$Territory==3]) # p = 0.06
mean(exper2$tot.approval[exper2$Strategy==3 & exper2$Territory==3]) - mean(exper2$tot.approval[exper2$Strategy==3 & exper2$Territory==2]) 
# effect = -0.34

# Comparing compromise with 20% territory vs Not Engage 20% territory
t.test(exper2$tot.approval[exper2$Strategy==4 & exper2$Territory==2], 
       exper2$tot.approval[exper2$Strategy==3 & exper2$Territory==2]) #p<0.01
mean(exper2$tot.approval[exper2$Strategy==4 & exper2$Territory==2]) - mean(exper2$tot.approval[exper2$Strategy==3 & exper2$Territory==2])
#0.66

# Comparing compromise 20% territory vs Not Engage 50% territory
t.test(exper2$tot.approval[exper2$Strategy==4 & exper2$Territory==2], 
       exper2$tot.approval[exper2$Strategy==3 & exper2$Territory==3]) #p<0.01
mean(exper2$tot.approval[exper2$Strategy==4 & exper2$Territory==2]) - mean(exper2$tot.approval[exper2$Strategy==3 & exper2$Territory==3])
# 1.00


##
## Figure 4: Effect of Proposal power (without division by Party or President's Party)
## Proposal Power
##

## Estimate Porposal Power
c.value <-qnorm(.95)

compr.tot.score.t2.c0.p1 <- mean(exper2$tot.approval[exper2$Strategy==4 & exper2$t2.c0.dum==1 & exper2$Proposer==1])
se.compr.tot.score.t2.c0.p1 <- sqrt(var(exper2$tot.approval[exper2$Strategy==4 & exper2$t2.c0.dum==1 & exper2$Proposer==1])/length(exper2$tot.approval[exper2$Strategy==4 & exper2$t2.c0.dum==1 & exper2$Proposer==1])) 
ci.up.compr.tot.score.t2.c0.p1 <- compr.tot.score.t2.c0.p1   + se.compr.tot.score.t2.c0.p1 * c.value   
ci.low.compr.tot.score.t2.c0.p1 <- compr.tot.score.t2.c0.p1   - se.compr.tot.score.t2.c0.p1 * c.value

compr.tot.score.t2.c0.p2 <- mean(exper2$tot.approval[exper2$Strategy==4 & exper2$t2.c0.dum==1 & exper2$Proposer==2])
se.compr.tot.score.t2.c0.p2 <- sqrt(var(exper2$tot.approval[exper2$Strategy==4 & exper2$t2.c0.dum==1 & exper2$Proposer==2])/length(exper2$tot.approval[exper2$Strategy==4 & exper2$t2.c0.dum==1 & exper2$Proposer==2])) 
ci.up.compr.tot.score.t2.c0.p2 <- compr.tot.score.t2.c0.p2   + se.compr.tot.score.t2.c0.p2 * c.value   
ci.low.compr.tot.score.t2.c0.p2 <- compr.tot.score.t2.c0.p2   - se.compr.tot.score.t2.c0.p2 * c.value


###

tot.app.prop.means<- c(compr.tot.score.t2.c0.p1, compr.tot.score.t2.c0.p2)
tot.app.prop.means.ci.up <- c(ci.up.compr.tot.score.t2.c0.p1, ci.up.compr.tot.score.t2.c0.p2)
tot.app.prop.means.ci.low <- c(ci.low.compr.tot.score.t2.c0.p1, ci.low.compr.tot.score.t2.c0.p2)

tot.app.prop.t.c.names <- c("Domestic Leader \n Proposes \n ", "Foreign Leader \n Proposes \n")


## Side by side in one plot
# Exported to PDF with height 5 width 6
pdf(file ="~/Dropbox/The Power of Compromise/World Politics/New WP Data and Figures 5-22-2020/compr_proposal_2_means.pdf", height = 3.5, width = 4.5)
par(mar=c(3,5,1,2))
plot(1:2, tot.app.prop.means , main = "", 
     ylab = "", xlab = "", cex.lab=1,
     ylim = c(-1.5, 1.15), xlim = c(0.75, 2.25), pch = 19, type = "p", xaxt="n", cex=1)
mtext("Average Approval Score", side=2, at=-.25, cex=1, line=2.5)
abline(h=0, col="blue", lty=2)
for(i in 1:length(tot.app.prop.means)){
  lines(c(i,i), c(tot.app.prop.means.ci.up[i], tot.app.prop.means.ci.low[i]))
  mtext(tot.app.prop.t.c.names[i], side=1, at=i, 2.12,tot.app.prop.t.c.names[i], cex=1)
}
dev.off()

# Test of proposal power for full sample on approval score
t.test(exper2$tot.approval[exper2$Proposer==1  & exper2$t2.c0.dum==1], 
       exper2$tot.approval[exper2$Proposer==2  & exper2$t2.c0.dum==1]) #p=0.11

# Test of proposal power for full sample for percent approving
t.test(exper2$supp2[exper2$Proposer==1  & exper2$t2.c0.dum==1], 
       exper2$supp2[exper2$Proposer==2  & exper2$t2.c0.dum==1]) #p=0.08
mean(exper2$supp2[is.na(exper2$Proposer)==FALSE & exper2$Proposer==1  & exper2$t2.c0.dum==1]) - mean(exper2$supp2[is.na(exper2$Proposer)==FALSE & exper2$Proposer==2  & exper2$t2.c0.dum==1])
# 12 percent more approve


##
## Figure 5
## Proposal power, controling for Party Match
##

## Estimate Porposal Power with Party Match
## dummy for party-match
c.value <-qnorm(.95)
exper2$party_match <- ifelse(exper2$polParty==exper2$Pres_Party, 1, 0)
party.match.data<- subset(exper2[exper2$party_match==1 | exper2$party_match==0, ])

compr.tot.score.t2.c0.dem.dem.p1 <- mean(exper2$tot.approval[exper2$Strategy==4 & exper2$t2.c0.dum==1 & exper2$polParty==1 & exper2$party_match==1 & exper2$Proposer==1])
se.compr.tot.score.t2.c0.dem.dem.p1 <- sqrt(var(exper2$tot.approval[exper2$Strategy==4 & exper2$t2.c0.dum==1 & exper2$polParty==1 & exper2$party_match==1 & exper2$Proposer==1])/length(exper2$tot.approval[exper2$Strategy==4 & exper2$t2.c0.dum==1 & exper2$polParty==1 & exper2$party_match==1 & exper2$Proposer==1])) 
ci.up.compr.tot.score.t2.c0.dem.dem.p1 <- compr.tot.score.t2.c0.dem.dem.p1   + se.compr.tot.score.t2.c0.dem.dem.p1 * c.value   
ci.low.compr.tot.score.t2.c0.dem.dem.p1 <- compr.tot.score.t2.c0.dem.dem.p1   - se.compr.tot.score.t2.c0.dem.dem.p1 * c.value   

compr.tot.score.t2.c0.rep.rep.p1 <- mean(exper2$tot.approval[exper2$Strategy==4 & exper2$t2.c0.dum==1 & exper2$polParty==2 & exper2$party_match==1 & exper2$Proposer==1])
se.compr.tot.score.t2.c0.rep.rep.p1 <- sqrt(var(exper2$tot.approval[exper2$Strategy==4 & exper2$t2.c0.dum==1 & exper2$polParty==1 & exper2$party_match==1 & exper2$Proposer==1])/length(exper2$tot.approval[exper2$Strategy==4 & exper2$t2.c0.dum==1 & exper2$polParty==1 & exper2$party_match==1 & exper2$Proposer==1])) 
ci.up.compr.tot.score.t2.c0.rep.rep.p1 <- compr.tot.score.t2.c0.rep.rep.p1   + se.compr.tot.score.t2.c0.rep.rep.p1 * c.value   
ci.low.compr.tot.score.t2.c0.rep.rep.p1 <- compr.tot.score.t2.c0.rep.rep.p1   - se.compr.tot.score.t2.c0.rep.rep.p1 * c.value 

compr.tot.score.t2.c0.dem.dem.p2 <- mean(exper2$tot.approval[exper2$Strategy==4 & exper2$t2.c0.dum==1 & exper2$polParty==1 & exper2$party_match==1 & exper2$Proposer==2])
se.compr.tot.score.t2.c0.dem.dem.p2 <- sqrt(var(exper2$tot.approval[exper2$Strategy==4 & exper2$t2.c0.dum==1 & exper2$polParty==1 & exper2$party_match==1 & exper2$Proposer==2])/length(exper2$tot.approval[exper2$Strategy==4 & exper2$t2.c0.dum==1 & exper2$polParty==1 & exper2$party_match==1 & exper2$Proposer==2])) 
ci.up.compr.tot.score.t2.c0.dem.dem.p2 <- compr.tot.score.t2.c0.dem.dem.p2   + se.compr.tot.score.t2.c0.dem.dem.p2 * c.value   
ci.low.compr.tot.score.t2.c0.dem.dem.p2 <- compr.tot.score.t2.c0.dem.dem.p2   - se.compr.tot.score.t2.c0.dem.dem.p2 * c.value   

compr.tot.score.t2.c0.rep.rep.p2 <- mean(exper2$tot.approval[exper2$Strategy==4 & exper2$t2.c0.dum==1 & exper2$polParty==2 & exper2$party_match==1 & exper2$Proposer==2])
se.compr.tot.score.t2.c0.rep.rep.p2 <- sqrt(var(exper2$tot.approval[exper2$Strategy==4 & exper2$t2.c0.dum==1 & exper2$polParty==1 & exper2$party_match==1 & exper2$Proposer==2])/length(exper2$tot.approval[exper2$Strategy==4 & exper2$t2.c0.dum==1 & exper2$polParty==1 & exper2$party_match==1 & exper2$Proposer==2])) 
ci.up.compr.tot.score.t2.c0.rep.rep.p2 <- compr.tot.score.t2.c0.rep.rep.p2   + se.compr.tot.score.t2.c0.rep.rep.p2 * c.value   
ci.low.compr.tot.score.t2.c0.rep.rep.p2 <- compr.tot.score.t2.c0.rep.rep.p2   - se.compr.tot.score.t2.c0.rep.rep.p2 * c.value 
###
compr.tot.score.t2.c0.no.match.dem.p1 <- mean(exper2$tot.approval[exper2$Strategy==4 & exper2$t2.c0.dum==1 & exper2$polParty==1 & exper2$party_match==0 & exper2$Proposer==1])
se.compr.tot.score.t2.c0.no.match.dem.p1 <- sqrt(var(exper2$tot.approval[exper2$Strategy==4 & exper2$t2.c0.dum==1 & exper2$polParty==1 & exper2$party_match==0 & exper2$Proposer==1])/length(exper2$tot.approval[exper2$Strategy==4 & exper2$t2.c0.dum==1 & exper2$polParty==1 & exper2$party_match==0 & exper2$Proposer==1])) 
ci.up.compr.tot.score.t2.c0.no.match.dem.p1 <- compr.tot.score.t2.c0.no.match.dem.p1   + se.compr.tot.score.t2.c0.no.match.dem.p1 * c.value   
ci.low.compr.tot.score.t2.c0.no.match.dem.p1 <- compr.tot.score.t2.c0.no.match.dem.p1   - se.compr.tot.score.t2.c0.no.match.dem.p1 * c.value   

compr.tot.score.t2.c0.no.match.rep.p1 <- mean(exper2$tot.approval[exper2$Strategy==4 & exper2$t2.c0.dum==1 & exper2$polParty==2 & exper2$party_match==0 & exper2$Proposer==1])
se.compr.tot.score.t2.c0.no.match.rep.p1 <- sqrt(var(exper2$tot.approval[exper2$Strategy==4 & exper2$t2.c0.dum==1 & exper2$polParty==1 & exper2$party_match==0 & exper2$Proposer==1])/length(exper2$tot.approval[exper2$Strategy==4 & exper2$t2.c0.dum==1 & exper2$polParty==1 & exper2$party_match==0 & exper2$Proposer==1])) 
ci.up.compr.tot.score.t2.c0.no.match.rep.p1 <- compr.tot.score.t2.c0.no.match.rep.p1   + se.compr.tot.score.t2.c0.no.match.rep.p1 * c.value   
ci.low.compr.tot.score.t2.c0.no.match.rep.p1 <- compr.tot.score.t2.c0.no.match.rep.p1   - se.compr.tot.score.t2.c0.no.match.rep.p1 * c.value 

compr.tot.score.t2.c0.no.match.dem.p2 <- mean(exper2$tot.approval[exper2$Strategy==4 & exper2$t2.c0.dum==1 & exper2$polParty==1 & exper2$party_match==0 & exper2$Proposer==2])
se.compr.tot.score.t2.c0.no.match.dem.p2 <- sqrt(var(exper2$tot.approval[exper2$Strategy==4 & exper2$t2.c0.dum==1 & exper2$polParty==1 & exper2$party_match==0 & exper2$Proposer==2])/length(exper2$tot.approval[exper2$Strategy==4 & exper2$t2.c0.dum==1 & exper2$polParty==1 & exper2$party_match==0 & exper2$Proposer==2])) 
ci.up.compr.tot.score.t2.c0.no.match.dem.p2 <- compr.tot.score.t2.c0.no.match.dem.p2   + se.compr.tot.score.t2.c0.no.match.dem.p2 * c.value   
ci.low.compr.tot.score.t2.c0.no.match.dem.p2 <- compr.tot.score.t2.c0.no.match.dem.p2   - se.compr.tot.score.t2.c0.no.match.dem.p2 * c.value   

compr.tot.score.t2.c0.no.match.rep.p2 <- mean(exper2$tot.approval[exper2$Strategy==4 & exper2$t2.c0.dum==1 & exper2$polParty==2 & exper2$party_match==0 & exper2$Proposer==2])
se.compr.tot.score.t2.c0.no.match.rep.p2 <- sqrt(var(exper2$tot.approval[exper2$Strategy==4 & exper2$t2.c0.dum==1 & exper2$polParty==1 & exper2$party_match==0 & exper2$Proposer==2])/length(exper2$tot.approval[exper2$Strategy==4 & exper2$t2.c0.dum==1 & exper2$polParty==1 & exper2$party_match==0 & exper2$Proposer==2])) 
ci.up.compr.tot.score.t2.c0.no.match.rep.p2 <- compr.tot.score.t2.c0.no.match.rep.p2   + se.compr.tot.score.t2.c0.no.match.rep.p2 * c.value   
ci.low.compr.tot.score.t2.c0.no.match.rep.p2 <- compr.tot.score.t2.c0.no.match.rep.p2   - se.compr.tot.score.t2.c0.no.match.rep.p2 * c.value 
###

tot.app.match.means.dem<- c(compr.tot.score.t2.c0.dem.dem.p1, compr.tot.score.t2.c0.dem.dem.p2, compr.tot.score.t2.c0.no.match.dem.p1, compr.tot.score.t2.c0.no.match.dem.p2)
tot.app.match.means.dem.ci.up <- c(ci.up.compr.tot.score.t2.c0.dem.dem.p1 , ci.up.compr.tot.score.t2.c0.dem.dem.p2, ci.up.compr.tot.score.t2.c0.no.match.dem.p1, ci.up.compr.tot.score.t2.c0.no.match.dem.p2 )
tot.app.match.means.dem.ci.low <- c(ci.low.compr.tot.score.t2.c0.dem.dem.p1, ci.low.compr.tot.score.t2.c0.dem.dem.p2, ci.low.compr.tot.score.t2.c0.no.match.dem.p1, ci.low.compr.tot.score.t2.c0.no.match.dem.p2)
tot.app.t.c.names.dem <- c("Party Match \n President Proposes \n ", "Party Match \n Foreign Leader \n Proposes", "No Party Match \n President Proposes \n ", "No Party Match \n Foreign Leader \n Proposes")

tot.app.match.means.rep<- c(compr.tot.score.t2.c0.rep.rep.p1, compr.tot.score.t2.c0.rep.rep.p2, compr.tot.score.t2.c0.no.match.rep.p1, compr.tot.score.t2.c0.no.match.rep.p2)
tot.app.match.means.rep.ci.up <- c(ci.up.compr.tot.score.t2.c0.rep.rep.p1 , ci.up.compr.tot.score.t2.c0.rep.rep.p2, ci.up.compr.tot.score.t2.c0.no.match.rep.p1, ci.up.compr.tot.score.t2.c0.no.match.rep.p2 )
tot.app.match.means.rep.ci.low <- c(ci.low.compr.tot.score.t2.c0.rep.rep.p1, ci.low.compr.tot.score.t2.c0.rep.rep.p2, ci.low.compr.tot.score.t2.c0.no.match.rep.p1, ci.low.compr.tot.score.t2.c0.no.match.rep.p2)


## Side by side in one plot
pdf(file ="~/Dropbox/The Power of Compromise/World Politics/New WP Data and Figures 5-22-2020/party_match_compr_proposal_means.pdf", height = 3.5, width = 4.5)
par(mar=c(2.5,5,1,2))
plot(1:4, tot.app.match.means.dem , main = "", 
     ylab = "", xlab = "", cex.lab=.8,cex.axis=.8,
     ylim = c(-2, 1.65), xlim = c(0.75, 4.25), pch = 19, type = "p", xaxt="n", cex=.8)
mtext("Average Approval Score", side=2, at=0, cex=.7, line=2.5)
abline(h=0, col="blue", lty=2)
for(i in 1:length(tot.app.match.means.dem)){
  lines(c(i,i), c(tot.app.match.means.dem.ci.up[i], tot.app.match.means.dem.ci.low[i]))
  mtext(tot.app.t.c.names.dem[i], side=1, at=i+.125, 1.12,tot.app.t.c.names.dem[i], cex=.55)
}
points(1.15:4.15, tot.app.match.means.rep, pch=22, cex=.8)
for(i in 1:length(tot.app.match.means.rep)){
  lines(c(i+.15,i+.15), c(tot.app.match.means.rep.ci.up[i], tot.app.match.means.rep.ci.low[i]))
}
text(3.813, 1.6, labels = "Audience of:", cex=.65)
text(3.8, 1.35, labels = "Democrats", cex=.65)
text(3.85, 1.1, labels = "Republicans", cex=.65)
points(3.37, 1.35, pch=19, cex=.8)
points(3.37, 1.1, pch=22, cex=.8)
dev.off()

# For results reported in the text:
## Percent of respondents supporting president based on proposal power 
## Support for Democrat who proposes among Democrats
mean(exper2$supp2[exper2$Strategy==4 & exper2$t2.c0.dum==1 & exper2$polParty==1 & exper2$party_match==1 & exper2$Proposer==1])
# 61
## Support for Democrat who proposes among Republicans
mean(exper2$supp2[exper2$Strategy==4 & exper2$t2.c0.dum==1 & exper2$polParty==2 & exper2$party_match==0 & exper2$Proposer==1])
# 13
## Support for Republican who proposes among Democrats
mean(exper2$supp2[exper2$Strategy==4 & exper2$t2.c0.dum==1 & exper2$polParty==1 & exper2$party_match==0 & exper2$Proposer==1])
# 70
## Support for Republican who proposes among Republicans
mean(exper2$supp2[exper2$Strategy==4 & exper2$t2.c0.dum==1 & exper2$polParty==2 & exper2$party_match==1 & exper2$Proposer==1])
# 63

# Comparison of difference in overall approval across comparable conditions from experiments 2 and 3
# First create data subsets of comparable conditions
exper2test <- exper2[is.na(exper2$Proposer)==FALSE, ]
exper3$party_match <- ifelse(exper3$party==exper3$Pres.Party, 1, 0)
exper3test <- subset(exper3[is.na(exper3$party_match)==FALSE, ])
exper3test$polParty <- exper3test$party

# Now test the differences, as reported in the text
t.test(exper2test$tot.approval[exper2test$party_match==1 & exper2test$polParty==1 & exper2test$t2.c0.dum==1 | exper2test$polParty==1 & exper2test$party_match==0 & exper2test$Proposer==1 & exper2test$t2.c0.dum==1 ], 
       exper3test$tot.approval[exper3test$party_match==1 & exper3test$polParty==1 | exper3test$polParty==1 & exper3test$party_match==0 & exper3test$ProposerA==1])
# p = 0.65
mean(exper2test$tot.approval[exper2test$party_match==1 & exper2test$polParty==1 & exper2test$t2.c0.dum==1 | exper2test$polParty==1 & exper2test$party_match==0 & exper2test$Proposer==1& exper2test$t2.c0.dum==1 ]) -
  mean(exper3test$tot.approval[exper3test$party_match==1 & exper3test$polParty==1 | exper3test$polParty==1 & exper3test$party_match==0 & exper3test$ProposerA==1])
# 0.13

# For comparable treatment effect of Dem vs Rep proposing among Republcian respondents:
t.test(exper3test$tot.approval[exper3test$party_match==1 & exper3test$party==2 & exper3test$ProposerA==1], 
       exper3test$tot.approval[exper3test$party_match==0 & exper3test$party==2 & exper3test$ProposerA==1])
#p=0.04
mean(exper3test$tot.approval[exper3test$party_match==1 & exper3test$party==2 & exper3test$ProposerA==1])- mean(exper3test$tot.approval[exper3test$party_match==0 & exper3test$party==2 & exper3test$ProposerA==1])
# 0.90


##
## Investment Experiment (exper4)
## Figure 5
##

# Subset based on party of respondent
exper4.D <- subset(exper4[exper4$party==1, ]) 
exper4.R <- subset(exper4[exper4$party==2, ])

# US Proposes: Proposer=1
# Foreign Proposes: Proposer = 2

#Full sample
t.test(exper4$tot.approval[exper4$Proposer==1], 
       exper4$tot.approval[exper4$Proposer==2]) 
#p=0.05
mean(exper4$tot.approval[exper4$Proposer==1])- mean(exper4$tot.approval[exper4$Proposer==2])
# Effect = 0.40

# For values reported in the text and Figure 6
# Democrat Respondents
t.test(exper4$tot.approval[exper4$Proposer==1  & exper4$party==1], 
       exper4$tot.approval[exper4$Proposer==2  & exper4$party==1]) 
# p = 0.04
mean(exper4$tot.approval[exper4$Proposer==1  & exper4$party==1])- mean(exper4$tot.approval[exper4$Proposer==2 & exper4$party==1])
# Effect = 0.65

#Republican respondents
t.test(exper4$tot.approval[exper4$Proposer==1  & exper4$party==2], 
       exper4$tot.approval[exper4$Proposer==2  & exper4$party==2]) 
# p = 0.51
mean(exper4$tot.approval[exper4$Proposer==1  & exper4$party==2])- mean(exper4$tot.approval[exper4$Proposer==2 & exper4$party==2])
# Effect= 0.27

# Now look at percent supporting
exper4$supp2 <- ifelse(exper4$tot.approval>0, 1, 0)
exper4$supp2 <- exper4$supp2 *100
# Democrat Respondents
t.test(exper4$supp2[exper4$Proposer==1  & exper4$party==1], 
       exper4$supp2[exper4$Proposer==2  & exper4$party==1]) 
#p<0.01
# 32% support for Dems support when foreign leader proposes versus 63% when domestic leader proposes

#Republican Respondents
t.test(exper4$supp2[exper4$Proposer==1  & exper4$party==2], 
       exper4$supp2[exper4$Proposer==2  & exper4$party==2]) 
#p=0.70
# 24% support for Reps when foreign leader proposes versus 27% when domestic leader proposes

#Generate Figure 6
set.seed(02138)
bootMean2 <- function(dat, dv="tot.approval", B=2000){
  bootResults <- matrix(NA, nrow=B, ncol=5)
  for (i in seq_len(B)){
    resample <- sample(1:nrow(dat),nrow(dat),replace=T)
    temp <- dat[resample,]
    dep.var <- eval(parse(text=paste("temp",dv,sep="$")))
    A <- mean(dep.var[which(temp$Proposer==1)], na.rm=TRUE)
    B <- mean(dep.var[which(temp$Proposer==2)], na.rm=TRUE)
    bootResults[i,1] <- (A)
    bootResults[i,2] <- (B)
    bootResults[i,3] <- (A-B)
    drop(list())
  }
  return(list(dv=dv, boot=bootResults, na.rm=TRUE))
}

Ex4D <- bootMean2(exper4.D , dv="tot.approval") 
Ex4R <- bootMean2(exper4.R , dv="tot.approval") 

B<-2000

# Density plots of Proposal Power Support
dens <- data.frame(y=c(Ex4D$boot[,1], Ex4D$boot[,2], Ex4R$boot[,1], Ex4R$boot[,2]), samp=rep(rep(c("Democrat Respondents", "Republican Respondents"), each=B*2),1), Treatment=rep(rep(c("President Proposes", "Foreign Leader Proposes"), each=B),2))


# p-velues and effects for figures
effect <- data.frame(
  label = c("Effect=0.65", "Effect=0.27"),
  samp   = c("Democrat Respondents", "Republican Respondents"),
  x     = c(0, 0),
  y     = c(2, 2)
)

pvalue <- data.frame(
  label = c("p=0.04", "p=0.51"),
  samp   = c("Democrat Respondents", "Republican Respondents"),
  x     = c(0, 0),
  y     = c(1.87, 1.87)
)

#Overlapping density plot with alpha channels
dev.new(height=2.5, width=4.5)
p <- ggplot(dens, aes(x=y)) + geom_density(aes(fill=Treatment), alpha=0.35) + facet_grid(~ samp, scales="fixed") + 
  geom_text(size = 2.5, data = effect,mapping = aes(x = x, y = y, label = label)) +
  geom_text(size = 2.5, data = pvalue,mapping = aes(x = x, y = y, label = label)) +
  labs(x="Average Approval Score", y="Density") + theme_bw() + theme(axis.text.y=element_blank(), 
                                                                     axis.text=element_text(size=6),axis.ticks.y=element_blank(), legend.title = element_text(size=7.5),
                                                                     legend.text = element_text(size=7), legend.key.size = unit(.75,"line"), strip.text = element_text(size = 6.5), axis.title=element_text(size=7.5)) + geom_vline(xintercept=0, linetype=3, alpha=0.3) + scale_fill_grey() 



print(p)
ggsave("Approv.Exper4.pdf", width=4.5, height=2.5)

## Difference in difference for republicans versus democrats reported in footnote

#Indicators for Proposer for regression
exper4$USProposes <- ifelse(exper4$Proposer==1, 1, 0)
exper4DR <- subset(exper4[exper4$party==1 | exper4$party==2, ])
exper4DR <- subset(exper4[exper4$Proposer==1 | exper4$Proposer==2, ])
exper4DR$Dem <- ifelse(exper4DR$party==1, 1, 0)
exper4DR$DemsReps <- exper4DR$supp2
DemsReps <- lm(DemsReps ~ USProposes + Dem + USProposes*Dem, data=exper4DR) 
summary(DemsReps)
# Diff-diff effect 26.6, p < 0.01

##
## Testing proposal of compromise without threat versus with threat
##

#Proposer == 5 US Proposes, but no threat or promise is made

## Treatment effects and p-values
#Full sample
t.test(exper4$tot.approval[exper4$Proposer==1], 
       exper4$tot.approval[exper4$Proposer==5]) 
#p=0.50
mean(exper4$tot.approval[exper4$Proposer==1])- mean(exper4$tot.approval[exper4$Proposer==5])
# Effect = 0.14

# Democrat Respondents
t.test(exper4$tot.approval[exper4$Proposer==1  & exper4$party==1], 
       exper4$tot.approval[exper4$Proposer==5  & exper4$party==1]) 
#p=0.25
mean(exper4$tot.approval[exper4$Proposer==1  & exper4$party==1])- mean(exper4$tot.approval[exper4$Proposer==5 & exper4$party==1])
# Effect = 0.38

#Republican respondents
t.test(exper4$tot.approval[exper4$Proposer==1  & exper4$party==2], 
       exper4$tot.approval[exper4$Proposer==5  & exper4$party==2]) 
#p=0.69
mean(exper4$tot.approval[exper4$Proposer==1  & exper4$party==2])- mean(exper4$tot.approval[exper4$Proposer==5 & exper4$party==2])
# Effect = -.17

## 
## Test of proposal power vs. Engage treatment holding outcomes constant
## Experiment 2

#Full sample - Approval Score
t.test(exper2$tot.approval[exper2$Strategy==4 & exper2$Proposer==1 & exper2$t2.c0.dum==1], 
       exper2$tot.approval[exper2$Strategy==2 &   exper2$t2.c0.dum==1 ]) 
# p = 0.67
mean(exper2$tot.approval[exper2$Strategy==4 & exper2$Proposer==1 & exper2$t2.c0.dum==1]) - mean(exper2$tot.approval[exper2$Strategy==2 &   exper2$t2.c0.dum==1 ]) 
# effect = -0.12

# Democrat President
t.test(exper2.D$tot.approval[exper2.D$Strategy==4 & exper2.D$Proposer==1 & exper2.D$t2.c0.dum==1], 
       exper2.D$tot.approval[exper2.D$Strategy==2 &   exper2.D$t2.c0.dum==1 ]) 
# p = 0.52
mean(exper2.D$tot.approval[exper2.D$Strategy==4 & exper2.D$Proposer==1  & exper2.D$t2.c0.dum==1]) - mean(exper2.D$tot.approval[exper2.D$Strategy==2 &   exper2.D$t2.c0.dum==1 ]) 
# effect = -0.27

# Republican President
t.test(exper2.R$tot.approval[exper2.R$Strategy==4 & exper2.R$Proposer==1  & exper2.R$t2.c0.dum==1], 
       exper2.R$tot.approval[exper2.R$Strategy==2 & exper2.R$t2.c0.dum==1 ]) 
# p < 0.92
mean(exper2.R$tot.approval[exper2.R$Strategy==4 & exper2.R$Proposer==1  & exper2.R$t2.c0.dum==1]) - mean(exper2.R$tot.approval[exper2.R$Strategy==2 &   exper2.R$t2.c0.dum==1 ]) 
#  effect = 0.04

##
## Analysis of mechanisms
##

# Compare President reputation Scores between for Not Engage and Compromise
#Average for all audiences/presidents, controling for outcomes
t.test(exper2$presRep[exper2$Strategy==3 & exper2$t2.c0.dum==1], exper2$presRep[exper2$Strategy==4 & exper2$t2.c0.dum==1])
#p < 0.01
mean(exper2$presRep[exper2$Strategy==3 & exper2$t2.c0.dum==1]) - mean(exper2$presRep[exper2$Strategy==4 & exper2$t2.c0.dum==1])
# 0.51 

## Test reputation mediation effect on Compromise

#Subset data for Not Engage and Compromise
data2 <- subset(exper2[(exper2$Strategy==3 | exper2$Strategy==4) & exper2$t2.c0.dum==1, ])

set.seed(02138)
presRep.med.c <- lm(presRep ~ Compromise + education + income + gender + polParty, data=data2)
presRep.dv.c <- lm(tot.approval ~ presRep + Compromise + education + income + gender + polParty, data=data2)
presRep.med.b.c <- mediate(presRep.med.c, presRep.dv.c, treat="Compromise", mediator="presRep", sims=1500)

summary(presRep.med.b.c) 
#Proportion mediated in 0.58 (p < 0.01), as reported in the text

# Compare whether or not respondents respondents were more proud in compromise versus the not engage conditions
#Average for all audiences/presidents, controling for outcomes
t.test(exper2$proud[exper2$Strategy==3 & exper2$t2.c0.dum==1], 
       exper2$proud[exper2$Strategy==4 & exper2$t2.c0.dum==1])
# p < 0.01
mean(exper2$proud[exper2$Strategy==4 & exper2$t2.c0.dum==1]) - mean(exper2$proud[exper2$Strategy==3 & exper2$t2.c0.dum==1])
# effect = 12% more are proud in compromise condition


##
## Appendix
## Demographics
##

#Demographics for Experiment 1

age1824 <- length(exper1$age[exper1$age<=24 & exper1$age>=18])
age2534 <- length(exper1$age[exper1$age<=34 & exper1$age>=25])
age3544 <- length(exper1$age[exper1$age<=44 & exper1$age>=35])
age4554 <- length(exper1$age[exper1$age<=54 & exper1$age>=45])
age5564 <- length(exper1$age[exper1$age<=64 & exper1$age>=55])
age65up <- length(exper1$age[exper1$age>=65])
age1824+age2534+age3544+age4554+age5564+age65up #604


age1824/604 # 26.8%
(age2534 + age3544)/604 # 62.3%
(age4554 + age5564)/604 # 10.1%
age65up/604 # 0.8%

## Gender 
length(exper1$gender[exper1$gender==1]) #378 = 62.6%
length(exper1$gender[exper1$gender==2]) #226 = 37.4%
378/(378+226)
226/(378+226)

##Education
Less_HS <- length(exper1$education[exper1$education==1 & is.na(exper1$education)==FALSE]) 
HS <- length(exper1$education[exper1$education==2 & is.na(exper1$education)==FALSE]) 
Some_Coll <- length(exper1$education[exper1$education==3 & is.na(exper1$education)==FALSE]) 
College <- length(exper1$education[exper1$education==4 | exper1$education==5 & is.na(exper1$education)==FALSE]) 
Masters <- length(exper1$education[exper1$education==6 & is.na(exper1$education)==FALSE]) 
Upper <- length(exper1$education[exper1$education>=7 & is.na(exper1$education)==FALSE]) 

Less_HS+HS+College+Some_Coll+Masters+Upper #604

Less_HS/604   #1.1%
HS/604        #9.1%
Some_Coll/604 # 28.1%
College/604   # 51.0%
Masters/604   # 8.9%
Upper/604     # 1.7%

## Income:
inc0_25 <- length(exper1$income[exper1$income==1 & is.na(exper1$income)==FALSE]) 
inc26_50 <- length(exper1$income[exper1$income==2 & is.na(exper1$income)==FALSE])
inc51_75 <- length(exper1$income[exper1$income==3 & is.na(exper1$income)==FALSE])
inc76_100 <- length(exper1$income[exper1$income==4 & is.na(exper1$income)==FALSE])
inc100_150 <- length(exper1$income[exper1$income==5  & is.na(exper1$income)==FALSE| exper1$income==6 & is.na(exper1$income)==FALSE]) 
inc150_200 <- length(exper1$income[exper1$income==7  & is.na(exper1$income)==FALSE| exper1$income==8 & is.na(exper1$income)==FALSE]) 
inc_up <- length(exper1$income[exper1$income==9 & is.na(exper1$income)==FALSE]) 


inc0_25+inc26_50+inc51_75+inc76_100+inc100_150+inc150_200+inc_up #604
(inc0_25+inc26_50)/604    # 57.3
(inc51_75+inc76_100)/604  # 33.8
inc100_150/604 # 7.1
inc150_200/604 # 0.8
inc_up/604     # 1.0

#Demographics for Experiment 2

exper2$age <- exper2$Q2_2 + 13
age1824 <- length(exper2$age[exper2$age<=24 & exper2$age>=18 & is.na(exper2$age)==FALSE])
age2534 <- length(exper2$age[exper2$age<=34 & exper2$age>=25 & is.na(exper2$age)==FALSE])
age3544 <- length(exper2$age[exper2$age<=44 & exper2$age>=35 & is.na(exper2$age)==FALSE])
age4554 <- length(exper2$age[exper2$age<=54 & exper2$age>=45 & is.na(exper2$age)==FALSE])
age5564 <- length(exper2$age[exper2$age<=64 & exper2$age>=55 & is.na(exper2$age)==FALSE])
age65up <- length(exper2$age[exper2$age>=65 & is.na(exper2$age)==FALSE])
age1824+age2534+age3544+age4554+age5564+age65up #1204


age1824/1204 # 19.3%
(age2534 + age3544)/1204 # 64.0%
(age4554 + age5564)/1204 # 15.4%
age65up/1204 # 1.3%

## Gender 
length(exper2$gender[exper2$gender==1]) #682 = 56.6%
length(exper2$gender[exper2$gender==2]) #522 = 43.4%
682/(682+522)

##Education
Less_HS <- length(exper2$edu[exper2$edu==1 & is.na(exper2$edu)==FALSE]) 
HS <- length(exper2$edu[exper2$edu==2 & is.na(exper2$edu)==FALSE]) 
Some_Coll <- length(exper2$edu[exper2$edu==3 & is.na(exper2$edu)==FALSE]) 
College <- length(exper2$edu[exper2$edu==4 | exper2$edu==5 & is.na(exper2$edu)==FALSE]) 
Masters <- length(exper2$edu[exper2$edu==6 & is.na(exper2$edu)==FALSE]) 
Upper <- length(exper2$edu[exper2$edu>=7 & is.na(exper2$edu)==FALSE]) 

Less_HS+HS+College+Some_Coll+Masters+Upper #1204
Less_HS/1204   #1.0%
HS/1204        #11.8%
Some_Coll/1204 # 28.7%
College/1204   # 47.8%
Masters/1204   # 8.6%
Upper/1204     # 2.2%
(College+Masters+Upper)/1204 
#58.6 have a college degree or more, as reported in the text

## Income:
inc0_25 <- length(exper2$income[exper2$income==1 & is.na(exper2$income)==FALSE]) 
inc26_50 <- length(exper2$income[exper2$income==2 & is.na(exper2$income)==FALSE])
inc51_75 <- length(exper2$income[exper2$income==3 & is.na(exper2$income)==FALSE])
inc76_100 <- length(exper2$income[exper2$income==4 & is.na(exper2$income)==FALSE])
inc100_150 <- length(exper2$income[exper2$income==5 & is.na(exper2$income)==FALSE| exper2$income==6 & is.na(exper2$income)==FALSE]) 
inc150_200 <- length(exper2$income[exper2$income==7 & is.na(exper2$income)==FALSE| exper2$income==8 & is.na(exper2$income)==FALSE]) 
inc_up <- length(exper2$income[exper2$income==9 & is.na(exper2$income)==FALSE]) 

inc0_25+inc26_50+inc51_75+inc76_100+inc100_150+inc150_200+inc_up #1204
(inc0_25 + inc26_50)/1204    # 55.2
(inc51_75 + inc76_100)/1204   # 35.5
inc100_150/1204 # 5.2
inc150_200/1204 # 2.3
inc_up/1204     # 1.7

# Percent identifyin as liberal for appendix text:
exper2$liberal <- ifelse(exper2$ideol<3, 1, 0)  #1=extremely liberal to 5=extremely conservative
length(exper2$liberal[exper2$liberal==1]) #622 
length(exper2$liberal[exper2$liberal==0]) #582
622/(622+582) # = 51.7%

#Demographics for Experiment 3

age1824 <- length(exper3$age[exper3$age<=24 & exper3$age>=18 & is.na(exper3$age)==FALSE])
age2534 <- length(exper3$age[exper3$age<=34 & exper3$age>=25 & is.na(exper3$age)==FALSE])
age3544 <- length(exper3$age[exper3$age<=44 & exper3$age>=35 & is.na(exper3$age)==FALSE])
age4554 <- length(exper3$age[exper3$age<=54 & exper3$age>=45 & is.na(exper3$age)==FALSE])
age5564 <- length(exper3$age[exper3$age<=64 & exper3$age>=55 & is.na(exper3$age)==FALSE])
age65up <- length(exper3$age[exper3$age>=65 & is.na(exper3$age)==FALSE])
age1824+age2534+age3544+age4554+age5564+age65up #594


age1824/594 # 11.3%
(age2534 + age3544)/594 # 35.7%
(age4554 + age5564)/594 # 32.8%
age65up/594 # 20.2%

## Gender 
length(exper3$gender[exper3$gender==1]) #293 = 46.6%
length(exper3$gender[exper3$gender==2]) #336 = 53.4%
293/(293+336)

##Education
Less_HS <- length(exper3$edu[exper3$edu==1 & is.na(exper3$edu)==FALSE]) 
HS <- length(exper3$edu[exper3$edu==2 & is.na(exper3$edu)==FALSE]) 
Some_Coll <- length(exper3$edu[exper3$edu==3 & is.na(exper3$edu)==FALSE]) 
College <- length(exper3$edu[exper3$edu==4 & is.na(exper3$edu)==FALSE]) + length(exper3$edu[exper3$edu==5 & is.na(exper3$edu)==FALSE]) 
Masters <- length(exper3$edu[exper3$edu==6 & is.na(exper3$edu)==FALSE]) 
Upper <- length(exper3$edu[exper3$edu>=7 & is.na(exper3$edu)==FALSE]) 

Less_HS+HS+College+Some_Coll+Masters+Upper #579

Less_HS/579  #2.6%
HS/579        #27.5%
Some_Coll/579 # 11.4%
College/579   # 39.8%
Masters/579   # 13.6%
Upper/579     # 5.2%

## Income:
inc0_25 <- length(exper3$income[exper3$income==1 & is.na(exper3$income)==FALSE]) 
inc26_50 <- length(exper3$income[exper3$income==2 & is.na(exper3$income)==FALSE])
inc51_75 <- length(exper3$income[exper3$income==3 & is.na(exper3$income)==FALSE])
inc76_100 <- length(exper3$income[exper3$income==4 & is.na(exper3$income)==FALSE])
inc100_150 <- length(exper3$income[exper3$income==5 & is.na(exper3$income)==FALSE]) + length(exper3$income[exper3$income==6 & is.na(exper3$income)==FALSE]) 
inc150_200 <- length(exper3$income[exper3$income==7 & is.na(exper3$income)==FALSE]) + length(exper3$income[exper3$income==7 & is.na(exper3$income)==FALSE]) 
inc_up <- length(exper3$income[exper3$income==9 & is.na(exper3$income)==FALSE]) 

inc0_25+inc26_50+inc51_75+inc76_100+inc100_150+inc150_200+inc_up #583
(inc0_25 + inc26_50)/583    # 46.8
(inc51_75 + inc76_100)/583   # 33.4
inc100_150/583 # 11.7
inc150_200/583 # 4.8
inc_up/583     # 3.3

#Demographics for Experiment 4

age1824 <- length(exper4$age[exper4$age<=24 & exper4$age>=18 & is.na(exper4$age)==FALSE])
age2534 <- length(exper4$age[exper4$age<=34 & exper4$age>=25 & is.na(exper4$age)==FALSE])
age3544 <- length(exper4$age[exper4$age<=44 & exper4$age>=35 & is.na(exper4$age)==FALSE])
age4554 <- length(exper4$age[exper4$age<=54 & exper4$age>=45 & is.na(exper4$age)==FALSE])
age5564 <- length(exper4$age[exper4$age<=64 & exper4$age>=55 & is.na(exper4$age)==FALSE])
age65up <- length(exper4$age[exper4$age>=65 & is.na(exper4$age)==FALSE])
age1824+age2534+age3544+age4554+age5564+age65up #539

age1824/539 # 9.3%
(age2534 + age3544)/539 # 32.1%
(age4554 + age5564)/539 # 37.8
age65up/539 # 20.8%

## Gender 
length(exper4$gender[exper4$gender==1]) #263 = 48.4%
length(exper4$gender[exper4$gender==2]) #280 = 51.6%
263/(263+280)

##Education
Less_HS <- length(exper4$edu[exper4$edu==1 & is.na(exper4$edu)==FALSE]) 
HS <- length(exper4$edu[exper4$edu==2 & is.na(exper4$edu)==FALSE]) 
Some_Coll <- length(exper4$edu[exper4$edu==3 & is.na(exper4$edu)==FALSE]) 
College <- length(exper4$edu[exper4$edu==4 & is.na(exper4$edu)==FALSE]) + length(exper4$edu[exper4$edu==5 & is.na(exper4$edu)==FALSE]) 
Masters <- length(exper4$edu[exper4$edu==6 & is.na(exper4$edu)==FALSE]) 
Upper <- length(exper4$edu[exper4$edu>=7 & is.na(exper4$edu)==FALSE]) 

Less_HS+HS+College+Some_Coll+Masters+Upper #541

Less_HS/541  #3.1%
HS/541        #25.5%
Some_Coll/541 # 13.1%
College/541   # 38.6%
Masters/541   # 15.0%
Upper/541     # 4.6%

## Income:
inc0_25 <- length(exper4$income[exper4$income==1 & is.na(exper4$income)==FALSE]) 
inc26_50 <- length(exper4$income[exper4$income==2 & is.na(exper4$income)==FALSE])
inc51_75 <- length(exper4$income[exper4$income==3 & is.na(exper4$income)==FALSE])
inc76_100 <- length(exper4$income[exper4$income==4 & is.na(exper4$income)==FALSE])
inc100_150 <- length(exper4$income[exper4$income==5 & is.na(exper4$income)==FALSE]) + length(exper4$income[exper4$income==6 & is.na(exper4$income)==FALSE]) 
inc150_200 <- length(exper4$income[exper4$income==7 & is.na(exper4$income)==FALSE]) + length(exper4$income[exper4$income==7 & is.na(exper4$income)==FALSE]) 
inc_up <- length(exper4$income[exper4$income==9 & is.na(exper4$income)==FALSE]) 

inc0_25+inc26_50+inc51_75+inc76_100+inc100_150+inc150_200+inc_up #552
(inc0_25 +inc26_50)/552    # 43.8
(inc51_75 + inc76_100)/552   # 33.2
inc100_150/552 # 12.0
inc150_200/552 # 8.3
inc_up/552     # 2.7

##
## Create Figure 1 of the appendix, which replicates  Figure 2 of the paper, but for party of respondents
##

bootMean3 <- function(dat, dv="tot.approval", B=2000){
  bootResults <- matrix(NA, nrow=B, ncol=5)
  for (i in seq_len(B)){
    resample <- sample(1:nrow(dat),nrow(dat),replace=T)
    temp <- dat[resample,]
    dep.var <- eval(parse(text=paste("temp",dv,sep="$")))
    A <- mean(dep.var[which(temp$polParty==1)], na.rm=TRUE)
    B <- mean(dep.var[which(temp$polParty==2)], na.rm=TRUE)
    C <- mean(dep.var[which(temp$Strategy==4)], na.rm=TRUE)
    bootResults[i,1] <- (A)
    bootResults[i,2] <- (B)
    bootResults[i,3] <- (C)
    bootResults[i,4] <- (C-B)
    bootResults[i,5] <- (B-A)
    drop(list())
  }
  return(list(dv=dv, boot=bootResults, Audience.Cost=mean(bootResults[,5], na.rm=TRUE), Compromise.Effect=mean(bootResults[,4], na.rm=TRUE)))
}


set.seed(02138)

Ex1SupportRD <- bootMean3(exper1comp, dv="tot.approval") 
Ex2SupportRD <- bootMean3(exper2comp, dv="tot.approval") 


dens <- data.frame(y=c(Ex1SupportRD$boot[,1], Ex1SupportRD$boot[,2], Ex2SupportRD$boot[,1], Ex2SupportRD$boot[,2]), samp=rep(rep(c("Experiment 1", "Experiment 2"), each=B*2),1), Treatment=rep(rep(c("Democrat Respondents", "Republican Respondents"), each=B),2))

# p-velues and effects for figures
effect <- data.frame(
  label = c("Effect=0.41", "Effect=0.69"),
  samp   = c("Experiment 1", "Experiment 2"),
  x     = c(-.5, -.5),
  y     = c(2.2, 2.2)
)

pvalue <- data.frame(
  label = c("p<0.01", "p=0.08"),
  samp   = c("Experiment 1", "Experiment 2"),
  x     = c(-.5, -.5),
  y     = c(2.05, 2.05)
)

#Overlapping density plot with alpha channels
dev.new(height=2.5, width=4.5)
p <- ggplot(dens, aes(x=y)) + geom_density(aes(fill=Treatment), alpha=0.35) + facet_grid(~ samp, scales="fixed") + 
  geom_text(size = 2.5, data = effect,mapping = aes(x = x, y = y, label = label)) +
  geom_text(size = 2.5, data = pvalue,mapping = aes(x = x, y = y, label = label)) +
  labs(x="Average Approval Score", y="Density") + theme_bw() + theme(axis.text.y=element_blank(), 
                                                                     axis.text=element_text(size=6),axis.ticks.y=element_blank(), legend.title = element_text(size=7.5),
                                                                     legend.text = element_text(size=7), legend.key.size = unit(.75,"line"), strip.text = element_text(size = 7.5), axis.title=element_text(size=7.5)) + geom_vline(xintercept=0, linetype=3, alpha=0.3) + scale_fill_grey() 

print(p)
ggsave("DemRepCompSuppEx1Ex2.pdf", width=4.5, height=2.5)

# Effects and p-values
#Experiment 1
t.test(exper1$tot.approval[exper1$Comp==1 & exper1$polParty==1], 
       exper1$tot.approval[exper1$Comp==1 & exper1$polParty==2]) # p < 0.01
mean(exper1$tot.approval[exper1$Comp==1 & exper1$polParty==1], na.rm=TRUE) - mean(exper1$tot.approval[exper1$Comp==1 & exper1$polParty==2], na.rm=TRUE) 
# effect = 0.41

#Experiment 2
t.test(exper2$tot.approval[exper2$Compromise==1 & exper2$t2.c0.dum==1 & exper2$polParty==1], 
       exper2$tot.approval[exper2$Compromise==1 & exper2$t2.c0.dum==1 & exper2$polParty==2]) # p 0 0.08
mean(exper2$tot.approval[exper2$Compromise==1 & exper2$t2.c0.dum==1 & exper2$polParty==1]) - mean(exper2$tot.approval[exper2$Compromise==1 & exper2$t2.c0.dum==1 & exper2$polParty==2]) 
# effect = 0.69

##
## Create Figure 2 of the appendix
##

## Estimate Porposal Power with Party Match
## dummy for party-match

c.value <-qnorm(.95)
exper3$party_match <- ifelse(exper3$party==exper3$Pres.Party, 1, 0)
EX3party.match.data<- subset(exper3[exper3$party_match==1 | exper3$party_match==0, ])
EX3party.match.data<- subset(EX3party.match.data[is.na(EX3party.match.data$tot.approval)==FALSE, ])

compr.tot.score.t2.c0.dem.dem.p1 <- mean(EX3party.match.data$tot.approval[EX3party.match.data$party_match==1 & EX3party.match.data$party==1 & EX3party.match.data$ProposerA==1])
se.compr.tot.score.t2.c0.dem.dem.p1 <- sqrt(var(EX3party.match.data$tot.approval[EX3party.match.data$party_match==1 & EX3party.match.data$party==1 & EX3party.match.data$ProposerA==1])/length(EX3party.match.data$tot.approval[EX3party.match.data$party_match==1 & EX3party.match.data$party==1 & EX3party.match.data$ProposerA==1])) 
ci.up.compr.tot.score.t2.c0.dem.dem.p1 <- compr.tot.score.t2.c0.dem.dem.p1   + se.compr.tot.score.t2.c0.dem.dem.p1 * c.value   
ci.low.compr.tot.score.t2.c0.dem.dem.p1 <- compr.tot.score.t2.c0.dem.dem.p1   - se.compr.tot.score.t2.c0.dem.dem.p1 * c.value   

compr.tot.score.t2.c0.rep.rep.p1 <- mean(EX3party.match.data$tot.approval[EX3party.match.data$party_match==1 & EX3party.match.data$party==2 & EX3party.match.data$ProposerA==1])
se.compr.tot.score.t2.c0.rep.rep.p1 <- sqrt(var(EX3party.match.data$tot.approval[EX3party.match.data$party_match==1 & EX3party.match.data$party==2 & EX3party.match.data$ProposerA==1])/length(EX3party.match.data$tot.approval[EX3party.match.data$party_match==1 & EX3party.match.data$party==2 & EX3party.match.data$ProposerA==1])) 
ci.up.compr.tot.score.t2.c0.rep.rep.p1 <- compr.tot.score.t2.c0.rep.rep.p1   + se.compr.tot.score.t2.c0.rep.rep.p1 * c.value   
ci.low.compr.tot.score.t2.c0.rep.rep.p1 <- compr.tot.score.t2.c0.rep.rep.p1   - se.compr.tot.score.t2.c0.rep.rep.p1 * c.value 

compr.tot.score.t2.c0.dem.dem.p2 <- mean(EX3party.match.data$tot.approval[EX3party.match.data$party_match==1 & EX3party.match.data$party==1 & EX3party.match.data$ProposerA==2])
se.compr.tot.score.t2.c0.dem.dem.p2 <- sqrt(var(EX3party.match.data$tot.approval[EX3party.match.data$party_match==1 & EX3party.match.data$party==1 & EX3party.match.data$ProposerA==2])/length(EX3party.match.data$tot.approval[EX3party.match.data$party_match==1 & EX3party.match.data$party==1 & EX3party.match.data$ProposerA==2])) 
ci.up.compr.tot.score.t2.c0.dem.dem.p2 <- compr.tot.score.t2.c0.dem.dem.p2   + se.compr.tot.score.t2.c0.dem.dem.p2 * c.value   
ci.low.compr.tot.score.t2.c0.dem.dem.p2 <- compr.tot.score.t2.c0.dem.dem.p2   - se.compr.tot.score.t2.c0.dem.dem.p2 * c.value   

compr.tot.score.t2.c0.rep.rep.p2 <- mean(EX3party.match.data$tot.approval[EX3party.match.data$party_match==1 & EX3party.match.data$party==2 & EX3party.match.data$ProposerA==2])
se.compr.tot.score.t2.c0.rep.rep.p2 <- sqrt(var(EX3party.match.data$tot.approval[EX3party.match.data$party_match==1 & EX3party.match.data$party==2 & EX3party.match.data$ProposerA==2])/length(EX3party.match.data$tot.approval[EX3party.match.data$party_match==1 & EX3party.match.data$party==2 & EX3party.match.data$ProposerA==2])) 
ci.up.compr.tot.score.t2.c0.rep.rep.p2 <- compr.tot.score.t2.c0.rep.rep.p2   + se.compr.tot.score.t2.c0.rep.rep.p2 * c.value   
ci.low.compr.tot.score.t2.c0.rep.rep.p2 <- compr.tot.score.t2.c0.rep.rep.p2   - se.compr.tot.score.t2.c0.rep.rep.p2 * c.value 
###
compr.tot.score.t2.c0.no.match.dem.p1 <- mean(EX3party.match.data$tot.approval[EX3party.match.data$party_match==0 & EX3party.match.data$party==1 & EX3party.match.data$ProposerA==1])
se.compr.tot.score.t2.c0.no.match.dem.p1 <- sqrt(var(EX3party.match.data$tot.approval[EX3party.match.data$party_match==0 & EX3party.match.data$party==1 & EX3party.match.data$ProposerA==1])/length(EX3party.match.data$tot.approval[EX3party.match.data$party_match==0 & EX3party.match.data$party==1 & EX3party.match.data$ProposerA==1])) 
ci.up.compr.tot.score.t2.c0.no.match.dem.p1 <- compr.tot.score.t2.c0.no.match.dem.p1   + se.compr.tot.score.t2.c0.no.match.dem.p1 * c.value   
ci.low.compr.tot.score.t2.c0.no.match.dem.p1 <- compr.tot.score.t2.c0.no.match.dem.p1   - se.compr.tot.score.t2.c0.no.match.dem.p1 * c.value   

compr.tot.score.t2.c0.no.match.rep.p1 <- mean(EX3party.match.data$tot.approval[EX3party.match.data$party_match==0 & EX3party.match.data$party==2 & EX3party.match.data$ProposerA==1])
se.compr.tot.score.t2.c0.no.match.rep.p1 <- sqrt(var(EX3party.match.data$tot.approval[EX3party.match.data$party_match==0 & EX3party.match.data$party==2 & EX3party.match.data$ProposerA==1])/length(EX3party.match.data$tot.approval[EX3party.match.data$party_match==0 & EX3party.match.data$party==2 & EX3party.match.data$ProposerA==1])) 
ci.up.compr.tot.score.t2.c0.no.match.rep.p1 <- compr.tot.score.t2.c0.no.match.rep.p1   + se.compr.tot.score.t2.c0.no.match.rep.p1 * c.value   
ci.low.compr.tot.score.t2.c0.no.match.rep.p1 <- compr.tot.score.t2.c0.no.match.rep.p1   - se.compr.tot.score.t2.c0.no.match.rep.p1 * c.value 

compr.tot.score.t2.c0.no.match.dem.p2 <- mean(EX3party.match.data$tot.approval[EX3party.match.data$party_match==0 & EX3party.match.data$party==1 & EX3party.match.data$ProposerA==2])
se.compr.tot.score.t2.c0.no.match.dem.p2 <- sqrt(var(EX3party.match.data$tot.approval[EX3party.match.data$party_match==0 & EX3party.match.data$party==1 & EX3party.match.data$ProposerA==2])/length(EX3party.match.data$tot.approval[EX3party.match.data$party_match==0 & EX3party.match.data$party==1 & EX3party.match.data$ProposerA==2])) 
ci.up.compr.tot.score.t2.c0.no.match.dem.p2 <- compr.tot.score.t2.c0.no.match.dem.p2   + se.compr.tot.score.t2.c0.no.match.dem.p2 * c.value   
ci.low.compr.tot.score.t2.c0.no.match.dem.p2 <- compr.tot.score.t2.c0.no.match.dem.p2   - se.compr.tot.score.t2.c0.no.match.dem.p2 * c.value   

compr.tot.score.t2.c0.no.match.rep.p2 <- mean(EX3party.match.data$tot.approval[EX3party.match.data$party_match==0 & EX3party.match.data$party==2 & EX3party.match.data$ProposerA==2])
se.compr.tot.score.t2.c0.no.match.rep.p2 <- sqrt(var(EX3party.match.data$tot.approval[EX3party.match.data$party_match==0 & EX3party.match.data$party==2 & EX3party.match.data$ProposerA==2])/length(EX3party.match.data$tot.approval[EX3party.match.data$party_match==0 & EX3party.match.data$party==2 & EX3party.match.data$ProposerA==2])) 
ci.up.compr.tot.score.t2.c0.no.match.rep.p2 <- compr.tot.score.t2.c0.no.match.rep.p2   + se.compr.tot.score.t2.c0.no.match.rep.p2 * c.value   
ci.low.compr.tot.score.t2.c0.no.match.rep.p2 <- compr.tot.score.t2.c0.no.match.rep.p2   - se.compr.tot.score.t2.c0.no.match.rep.p2 * c.value 
###

tot.app.match.means.dem<- c(compr.tot.score.t2.c0.dem.dem.p1, compr.tot.score.t2.c0.dem.dem.p2, compr.tot.score.t2.c0.no.match.dem.p1, compr.tot.score.t2.c0.no.match.dem.p2)
tot.app.match.means.dem.ci.up <- c(ci.up.compr.tot.score.t2.c0.dem.dem.p1 , ci.up.compr.tot.score.t2.c0.dem.dem.p2, ci.up.compr.tot.score.t2.c0.no.match.dem.p1, ci.up.compr.tot.score.t2.c0.no.match.dem.p2 )
tot.app.match.means.dem.ci.low <- c(ci.low.compr.tot.score.t2.c0.dem.dem.p1, ci.low.compr.tot.score.t2.c0.dem.dem.p2, ci.low.compr.tot.score.t2.c0.no.match.dem.p1, ci.low.compr.tot.score.t2.c0.no.match.dem.p2)
tot.app.t.c.names.dem <- c("Party Match \n President Proposes \n ", "Party Match \n Foreign Leader \n Proposes", "No Party Match \n President Proposes \n ", "No Party Match \n Foreign Leader \n Proposes")

tot.app.match.means.rep<- c(compr.tot.score.t2.c0.rep.rep.p1, compr.tot.score.t2.c0.rep.rep.p2, compr.tot.score.t2.c0.no.match.rep.p1, compr.tot.score.t2.c0.no.match.rep.p2)
tot.app.match.means.rep.ci.up <- c(ci.up.compr.tot.score.t2.c0.rep.rep.p1 , ci.up.compr.tot.score.t2.c0.rep.rep.p2, ci.up.compr.tot.score.t2.c0.no.match.rep.p1, ci.up.compr.tot.score.t2.c0.no.match.rep.p2 )
tot.app.match.means.rep.ci.low <- c(ci.low.compr.tot.score.t2.c0.rep.rep.p1, ci.low.compr.tot.score.t2.c0.rep.rep.p2, ci.low.compr.tot.score.t2.c0.no.match.rep.p1, ci.low.compr.tot.score.t2.c0.no.match.rep.p2)


## Side by side in one plot
#pdf(file ="/Users/ryanbrutger/Dropbox/What Audiences Want/Data/exper3_party_match_compr_proposal_means.pdf", height = 7, width = 12)
par(mar=c(6,5,1,2))
plot(1:4, tot.app.match.means.dem , main = "", 
     ylab = "", xlab = "", cex.lab=2,
     ylim = c(-1.65, 1.65), xlim = c(0.75, 4.25), pch = 19, type = "p", xaxt="n", cex=2)
mtext("Average Approval Score", side=2, at=0, cex=1.9, line=2.5)
abline(h=0, col="blue", lty=2)
for(i in 1:length(tot.app.match.means.dem)){
  lines(c(i,i), c(tot.app.match.means.dem.ci.up[i], tot.app.match.means.dem.ci.low[i]))
  mtext(tot.app.t.c.names.dem[i], side=1, at=i+.125, 4.12,tot.app.t.c.names.dem[i], cex=1.7)
}
points(1.15:4.15, tot.app.match.means.rep, pch=22, cex=2)
for(i in 1:length(tot.app.match.means.rep)){
  lines(c(i+.15,i+.15), c(tot.app.match.means.rep.ci.up[i], tot.app.match.means.rep.ci.low[i]))
}
text(3.913, 1.6, labels = "Audience of:", cex=2)
text(3.913, 1.35, labels = "Democrats", cex=2)
text(3.95, 1.1, labels = "Republicans", cex=2)
points(3.56, 1.35, pch=19, cex=2)
points(3.56, 1.1, pch=22, cex=2)
#dev.off()


##
## The following code examines approval of the president using a dichatomous measure of approval
## 
##

## Rescale dichatamous measure so results are in percent approving
exper1$supp2 <- exper1$supp * 100
exper2$supp2 <- exper2$supp * 100

##
## Create Figure 3 of the appendix, which replicates Figure 1 of main paper using dichotomous measure of support
##

bootMean2 <- function(dat, dv="supp2", B=2000){
  bootResults <- matrix(NA, nrow=B, ncol=5)
  for (i in seq_len(B)){
    resample <- sample(1:nrow(dat),nrow(dat),replace=T)
    temp <- dat[resample,]
    dep.var <- eval(parse(text=paste("temp",dv,sep="$")))
    A <- mean(dep.var[which(temp$Strategy==1)], na.rm=TRUE)
    B <- mean(dep.var[which(temp$Strategy==3)], na.rm=TRUE)
    C <- mean(dep.var[which(temp$Strategy==4)], na.rm=TRUE)
    bootResults[i,1] <- (A)
    bootResults[i,2] <- (B)
    bootResults[i,3] <- (C)
    bootResults[i,4] <- (C-B)
    bootResults[i,5] <- (B-A)
    drop(list())
  }
  return(list(dv=dv, boot=bootResults, Audience.Cost=mean(bootResults[,5], na.rm=TRUE), Compromise.Effect=mean(bootResults[,4], na.rm=TRUE)))
}

## Experiment 1
## Subset data by Party of President
exper1.D <- subset(exper1[exper1$Pres_Party==1, ]) # Subset data for Democrat as President
exper1.R <- subset(exper1[exper1$Pres_Party==2, ]) # Subset data for Republican as President

set.seed(02138)

SupportEx1 <- bootMean2(exper1, dv="supp2") 
SupportEx1D <- bootMean2(exper1.D, dv="supp2") 
SupportEx1R <- bootMean2(exper1.R, dv="supp2") 

B<-2000

# Density plots of Compromise vs Not Engage by by party of the president
dens <- data.frame(y=c(SupportEx1$boot[,2], SupportEx1$boot[,3], SupportEx1D$boot[,2], SupportEx1D$boot[,3], SupportEx1R$boot[,2], SupportEx1R$boot[,3]), samp=rep(rep(c("1. Full Study", "2. Democrat President", "3. Republican President"), each=B*2),1), Treatment=rep(rep(c("Not Engage", "Compromise"), each=B),3))

# p-values and effects for figure:
effect <- data.frame(
  label = c("Effect=14.9", "Effect=16.5", "Effect=13.4"),
  samp   = c("1. Full Study", "2. Democrat President", "3. Republican President"),
  x     = c(38, 38, 38),
  y     = c(.132, .132, .132)
)

pvalue <- data.frame(
  label = c("p<0.01", "p=0.02", "p=0.06"),
  samp   = c("1. Full Study", "2. Democrat President", "3. Republican President"),
  x     = c(38, 38, 38),
  y     = c(.125, .125, .125)
)

#Overlapping density plot with alpha channels
dev.new(height=2, width=7)
p <- ggplot(dens, aes(x=y)) + geom_density(aes(fill=Treatment), alpha=0.35) + facet_grid(~ samp, scales="fixed") + 
  geom_text(size = 2.7, data = effect,mapping = aes(x = x, y = y, label = label)) +
  geom_text(size = 2.7, data = pvalue,mapping = aes(x = x, y = y, label = label)) +
  labs(x="Average Approval Score", y="Density") + theme_bw() + theme(axis.text.y=element_blank(), 
                                                                     axis.text=element_text(size=6),axis.ticks.y=element_blank(), legend.title = element_text(size=7.5),
                                                                     legend.text = element_text(size=7), legend.key.size = unit(.75,"line"),axis.title=element_text(size=7.5), strip.text = element_text(size = 6.5)) + geom_vline(xintercept=0, linetype=3, alpha=0.3) + scale_fill_grey() 


print(p)
ggsave("PercSuppExper1PresParty.pdf", width=8, height=3)

## Effects and p-values for Figure 1, Experiment 1

#Full Study
t.test(exper1$supp2[exper1$Comp==1], exper1$supp2[exper1$Not_Engage==1]) 
# p < 0.00
mean(exper1$supp2[exper1$Comp==1], na.rm=TRUE) - mean(exper1$supp2[exper1$Not_Engage==1], na.rm=TRUE) 
# effect = 14.9

#Dem President
t.test(exper1.D$supp2[exper1.D$Comp==1], exper1.D$supp2[exper1.D$Not_Engage==1]) 
# p < 0.02
mean(exper1.D$supp2[exper1.D$Comp==1], na.rm=TRUE) - mean(exper1.D$supp2[exper1.D$Not_Engage==1], na.rm=TRUE) 
# effect = 16.5

#Rep President
t.test(exper1.R$supp2[exper1.R$Comp==1], exper1.R$supp2[exper1.R$Not_Engage==1]) 
# p < 0.06
mean(exper1.R$supp2[exper1.R$Comp==1], na.rm=TRUE) - mean(exper1.R$supp2[exper1.R$Not_Engage==1], na.rm=TRUE) 
# effect = 13.4


## Experiment 2
## Subset data by Party of President and hold outcomes constant at 20% territory gained
exper2.D <- subset(exper2[exper2$Pres_Party==1 & exper2$t2.c0.dum==1, ]) # Subset data for Democrat as President
exper2.R <- subset(exper2[exper2$Pres_Party==2 & exper2$t2.c0.dum==1, ]) # Subset data for Republican as President

set.seed(02138)

SupportEx2 <- bootMean2(exper2, dv="supp2") 
SupportEx2D <- bootMean2(exper2.D, dv="supp2") 
SupportEx2R <- bootMean2(exper2.R, dv="supp2") 

B<-2000

# Density plots of Compromise vs Not Engage by ideology
dens <- data.frame(y=c(SupportEx2$boot[,2], SupportEx2$boot[,3], SupportEx2D$boot[,2], SupportEx2D$boot[,3], SupportEx2R$boot[,2], SupportEx2R$boot[,3]), samp=rep(rep(c("1. Full Study", "2. Democrat President", "3. Republican President"), each=B*2),1), Treatment=rep(rep(c("Not Engage", "Compromise"), each=B),3))

# p-values and effects for figure:
effect <- data.frame(
  label = c("Effect=14.4", "Effect=10.2", "Effect=18.5"),
  samp   = c("1. Full Study", "2. Democrat President", "3. Republican President"),
  x     = c(38, 38, 38),
  y     = c(.188, .188, .188)
)

pvalue <- data.frame(
  label = c("p<0.01", "p=0.13", "p<0.01"),
  samp   = c("1. Full Study", "2. Democrat President", "3. Republican President"),
  x     = c(38, 38, 38),
  y     = c(.176, .176, .176)
)

#Overlapping density plot with alpha channels
dev.new(height=2, width=7)
p <- ggplot(dens, aes(x=y)) + geom_density(aes(fill=Treatment), alpha=0.35) + facet_grid(~ samp, scales="fixed") + 
  geom_text(size = 2.7, data = effect,mapping = aes(x = x, y = y, label = label)) +
  geom_text(size = 2.7, data = pvalue,mapping = aes(x = x, y = y, label = label)) +
  labs(x="Average Approval Score", y="Density") + theme_bw() + theme(axis.text.y=element_blank(), 
                                                                     axis.text=element_text(size=6),axis.ticks.y=element_blank(), legend.title = element_text(size=7.5),
                                                                     legend.text = element_text(size=7), legend.key.size = unit(.75,"line"),axis.title=element_text(size=7.5), strip.text = element_text(size = 6.5)) + geom_vline(xintercept=0, linetype=3, alpha=0.3) + scale_fill_grey() 


print(p)
ggsave("PercSuppExper2PresParty.pdf", width=8, height=3)

#Full Study
t.test(exper2$supp2[exper2$Comp==1 & exper2$t2.c0.dum==1], exper2$supp2[exper2$Not_Engage==1 & exper2$t2.c0.dum==1]) 
# p < 0.00
mean(exper2$supp2[exper2$Comp==1 & exper2$t2.c0.dum==1], na.rm=TRUE) - mean(exper2$supp2[exper2$Not_Engage==1 & exper2$t2.c0.dum==1], na.rm=TRUE) 
# effect = 14.4

#Dem President
t.test(exper2.D$supp2[exper2.D$Comp==1], exper2.D$supp2[exper2.D$Not_Engage==1]) 
# p < 0.13
mean(exper2.D$supp2[exper2.D$Comp==1], na.rm=TRUE) - mean(exper2.D$supp2[exper2.D$Not_Engage==1], na.rm=TRUE) 
# effect = 10.2

#Rep President
t.test(exper2.R$supp2[exper2.R$Comp==1], exper2.R$supp2[exper2.R$Not_Engage==1]) 
# p < 0.00
mean(exper2.R$supp2[exper2.R$Comp==1], na.rm=TRUE) - mean(exper2.R$supp2[exper2.R$Not_Engage==1], na.rm=TRUE) 
# effect = 18.5


##
## Create Figure 4 of the appendix, which replicates Figure 5 of the main paper, but uses a dichotomous support measure
##

## Estimate Proposal Power with Party Match
## dummy for party-match
c.value <-qnorm(.95)
exper2$party_match <- ifelse(exper2$polParty==exper2$Pres_Party, 1, 0)
party.match.data<- subset(exper2[exper2$party_match==1 | exper2$party_match==0, ])

compr.tot.score.t2.c0.dem.dem.p1 <- mean(exper2$supp2[exper2$Strategy==4 & exper2$t2.c0.dum==1 & exper2$polParty==1 & exper2$party_match==1 & exper2$Proposer==1])
se.compr.tot.score.t2.c0.dem.dem.p1 <- sqrt(var(exper2$supp2[exper2$Strategy==4 & exper2$t2.c0.dum==1 & exper2$polParty==1 & exper2$party_match==1 & exper2$Proposer==1])/length(exper2$supp2[exper2$Strategy==4 & exper2$t2.c0.dum==1 & exper2$polParty==1 & exper2$party_match==1 & exper2$Proposer==1])) 
ci.up.compr.tot.score.t2.c0.dem.dem.p1 <- compr.tot.score.t2.c0.dem.dem.p1   + se.compr.tot.score.t2.c0.dem.dem.p1 * c.value   
ci.low.compr.tot.score.t2.c0.dem.dem.p1 <- compr.tot.score.t2.c0.dem.dem.p1   - se.compr.tot.score.t2.c0.dem.dem.p1 * c.value   

compr.tot.score.t2.c0.rep.rep.p1 <- mean(exper2$supp2[exper2$Strategy==4 & exper2$t2.c0.dum==1 & exper2$polParty==2 & exper2$party_match==1 & exper2$Proposer==1])
se.compr.tot.score.t2.c0.rep.rep.p1 <- sqrt(var(exper2$supp2[exper2$Strategy==4 & exper2$t2.c0.dum==1 & exper2$polParty==1 & exper2$party_match==1 & exper2$Proposer==1])/length(exper2$supp2[exper2$Strategy==4 & exper2$t2.c0.dum==1 & exper2$polParty==1 & exper2$party_match==1 & exper2$Proposer==1])) 
ci.up.compr.tot.score.t2.c0.rep.rep.p1 <- compr.tot.score.t2.c0.rep.rep.p1   + se.compr.tot.score.t2.c0.rep.rep.p1 * c.value   
ci.low.compr.tot.score.t2.c0.rep.rep.p1 <- compr.tot.score.t2.c0.rep.rep.p1   - se.compr.tot.score.t2.c0.rep.rep.p1 * c.value 

compr.tot.score.t2.c0.dem.dem.p2 <- mean(exper2$supp2[exper2$Strategy==4 & exper2$t2.c0.dum==1 & exper2$polParty==1 & exper2$party_match==1 & exper2$Proposer==2])
se.compr.tot.score.t2.c0.dem.dem.p2 <- sqrt(var(exper2$supp2[exper2$Strategy==4 & exper2$t2.c0.dum==1 & exper2$polParty==1 & exper2$party_match==1 & exper2$Proposer==2])/length(exper2$supp2[exper2$Strategy==4 & exper2$t2.c0.dum==1 & exper2$polParty==1 & exper2$party_match==1 & exper2$Proposer==2])) 
ci.up.compr.tot.score.t2.c0.dem.dem.p2 <- compr.tot.score.t2.c0.dem.dem.p2   + se.compr.tot.score.t2.c0.dem.dem.p2 * c.value   
ci.low.compr.tot.score.t2.c0.dem.dem.p2 <- compr.tot.score.t2.c0.dem.dem.p2   - se.compr.tot.score.t2.c0.dem.dem.p2 * c.value   

compr.tot.score.t2.c0.rep.rep.p2 <- mean(exper2$supp2[exper2$Strategy==4 & exper2$t2.c0.dum==1 & exper2$polParty==2 & exper2$party_match==1 & exper2$Proposer==2])
se.compr.tot.score.t2.c0.rep.rep.p2 <- sqrt(var(exper2$supp2[exper2$Strategy==4 & exper2$t2.c0.dum==1 & exper2$polParty==1 & exper2$party_match==1 & exper2$Proposer==2])/length(exper2$supp2[exper2$Strategy==4 & exper2$t2.c0.dum==1 & exper2$polParty==1 & exper2$party_match==1 & exper2$Proposer==2])) 
ci.up.compr.tot.score.t2.c0.rep.rep.p2 <- compr.tot.score.t2.c0.rep.rep.p2   + se.compr.tot.score.t2.c0.rep.rep.p2 * c.value   
ci.low.compr.tot.score.t2.c0.rep.rep.p2 <- compr.tot.score.t2.c0.rep.rep.p2   - se.compr.tot.score.t2.c0.rep.rep.p2 * c.value 
###
compr.tot.score.t2.c0.no.match.dem.p1 <- mean(exper2$supp2[exper2$Strategy==4 & exper2$t2.c0.dum==1 & exper2$polParty==1 & exper2$party_match==0 & exper2$Proposer==1])
se.compr.tot.score.t2.c0.no.match.dem.p1 <- sqrt(var(exper2$supp2[exper2$Strategy==4 & exper2$t2.c0.dum==1 & exper2$polParty==1 & exper2$party_match==0 & exper2$Proposer==1])/length(exper2$supp2[exper2$Strategy==4 & exper2$t2.c0.dum==1 & exper2$polParty==1 & exper2$party_match==0 & exper2$Proposer==1])) 
ci.up.compr.tot.score.t2.c0.no.match.dem.p1 <- compr.tot.score.t2.c0.no.match.dem.p1   + se.compr.tot.score.t2.c0.no.match.dem.p1 * c.value   
ci.low.compr.tot.score.t2.c0.no.match.dem.p1 <- compr.tot.score.t2.c0.no.match.dem.p1   - se.compr.tot.score.t2.c0.no.match.dem.p1 * c.value   

compr.tot.score.t2.c0.no.match.rep.p1 <- mean(exper2$supp2[exper2$Strategy==4 & exper2$t2.c0.dum==1 & exper2$polParty==2 & exper2$party_match==0 & exper2$Proposer==1])
se.compr.tot.score.t2.c0.no.match.rep.p1 <- sqrt(var(exper2$supp2[exper2$Strategy==4 & exper2$t2.c0.dum==1 & exper2$polParty==1 & exper2$party_match==0 & exper2$Proposer==1])/length(exper2$supp2[exper2$Strategy==4 & exper2$t2.c0.dum==1 & exper2$polParty==1 & exper2$party_match==0 & exper2$Proposer==1])) 
ci.up.compr.tot.score.t2.c0.no.match.rep.p1 <- compr.tot.score.t2.c0.no.match.rep.p1   + se.compr.tot.score.t2.c0.no.match.rep.p1 * c.value   
ci.low.compr.tot.score.t2.c0.no.match.rep.p1 <- compr.tot.score.t2.c0.no.match.rep.p1   - se.compr.tot.score.t2.c0.no.match.rep.p1 * c.value 

compr.tot.score.t2.c0.no.match.dem.p2 <- mean(exper2$supp2[exper2$Strategy==4 & exper2$t2.c0.dum==1 & exper2$polParty==1 & exper2$party_match==0 & exper2$Proposer==2])
se.compr.tot.score.t2.c0.no.match.dem.p2 <- sqrt(var(exper2$supp2[exper2$Strategy==4 & exper2$t2.c0.dum==1 & exper2$polParty==1 & exper2$party_match==0 & exper2$Proposer==2])/length(exper2$supp2[exper2$Strategy==4 & exper2$t2.c0.dum==1 & exper2$polParty==1 & exper2$party_match==0 & exper2$Proposer==2])) 
ci.up.compr.tot.score.t2.c0.no.match.dem.p2 <- compr.tot.score.t2.c0.no.match.dem.p2   + se.compr.tot.score.t2.c0.no.match.dem.p2 * c.value   
ci.low.compr.tot.score.t2.c0.no.match.dem.p2 <- compr.tot.score.t2.c0.no.match.dem.p2   - se.compr.tot.score.t2.c0.no.match.dem.p2 * c.value   

compr.tot.score.t2.c0.no.match.rep.p2 <- mean(exper2$supp2[exper2$Strategy==4 & exper2$t2.c0.dum==1 & exper2$polParty==2 & exper2$party_match==0 & exper2$Proposer==2])
se.compr.tot.score.t2.c0.no.match.rep.p2 <- sqrt(var(exper2$supp2[exper2$Strategy==4 & exper2$t2.c0.dum==1 & exper2$polParty==1 & exper2$party_match==0 & exper2$Proposer==2])/length(exper2$supp2[exper2$Strategy==4 & exper2$t2.c0.dum==1 & exper2$polParty==1 & exper2$party_match==0 & exper2$Proposer==2])) 
ci.up.compr.tot.score.t2.c0.no.match.rep.p2 <- compr.tot.score.t2.c0.no.match.rep.p2   + se.compr.tot.score.t2.c0.no.match.rep.p2 * c.value   
ci.low.compr.tot.score.t2.c0.no.match.rep.p2 <- compr.tot.score.t2.c0.no.match.rep.p2   - se.compr.tot.score.t2.c0.no.match.rep.p2 * c.value 
###

tot.app.match.means.dem<- c(compr.tot.score.t2.c0.dem.dem.p1, compr.tot.score.t2.c0.dem.dem.p2, compr.tot.score.t2.c0.no.match.dem.p1, compr.tot.score.t2.c0.no.match.dem.p2)
tot.app.match.means.dem.ci.up <- c(ci.up.compr.tot.score.t2.c0.dem.dem.p1 , ci.up.compr.tot.score.t2.c0.dem.dem.p2, ci.up.compr.tot.score.t2.c0.no.match.dem.p1, ci.up.compr.tot.score.t2.c0.no.match.dem.p2 )
tot.app.match.means.dem.ci.low <- c(ci.low.compr.tot.score.t2.c0.dem.dem.p1, ci.low.compr.tot.score.t2.c0.dem.dem.p2, ci.low.compr.tot.score.t2.c0.no.match.dem.p1, ci.low.compr.tot.score.t2.c0.no.match.dem.p2)
tot.app.t.c.names.dem <- c("Party Match \n President Proposes \n ", "Party Match \n Foreign Leader \n Proposes", "No Party Match \n President Proposes \n ", "No Party Match \n Foreign Leader \n Proposes")

tot.app.match.means.rep<- c(compr.tot.score.t2.c0.rep.rep.p1, compr.tot.score.t2.c0.rep.rep.p2, compr.tot.score.t2.c0.no.match.rep.p1, compr.tot.score.t2.c0.no.match.rep.p2)
tot.app.match.means.rep.ci.up <- c(ci.up.compr.tot.score.t2.c0.rep.rep.p1 , ci.up.compr.tot.score.t2.c0.rep.rep.p2, ci.up.compr.tot.score.t2.c0.no.match.rep.p1, ci.up.compr.tot.score.t2.c0.no.match.rep.p2 )
tot.app.match.means.rep.ci.low <- c(ci.low.compr.tot.score.t2.c0.rep.rep.p1, ci.low.compr.tot.score.t2.c0.rep.rep.p2, ci.low.compr.tot.score.t2.c0.no.match.rep.p1, ci.low.compr.tot.score.t2.c0.no.match.rep.p2)


## Side by side in one plot
#pdf(file ="/Users/ryanbrutger/Dropbox/What Audiences Want/Data/party_match_compr_proposal_meansSupp2.pdf", height = 7, width = 12)
par(mar=c(6,5,1,2))
plot(1:4, tot.app.match.means.dem , main = "", 
     ylab = "", xlab = "", cex.lab=2,
     ylim = c(0, 100), xlim = c(0.75, 4.25), pch = 19, type = "p", xaxt="n", cex=2)
mtext("Percent Approving", side=2, at=50, cex=1.9, line=2.5)
abline(h=50, col="blue", lty=2)
for(i in 1:length(tot.app.match.means.dem)){
  lines(c(i,i), c(tot.app.match.means.dem.ci.up[i], tot.app.match.means.dem.ci.low[i]))
  mtext(tot.app.t.c.names.dem[i], side=1, at=i+.125, 4.12,tot.app.t.c.names.dem[i], cex=1.7)
}
points(1.15:4.15, tot.app.match.means.rep, pch=22, cex=2)
for(i in 1:length(tot.app.match.means.rep)){
  lines(c(i+.15,i+.15), c(tot.app.match.means.rep.ci.up[i], tot.app.match.means.rep.ci.low[i]))
}
text(3.913, 95, labels = "Audience of:", cex=2)
text(3.913, 89, labels = "Democrats", cex=2)
text(3.95, 82, labels = "Republicans", cex=2)
points(3.56, 89, pch=19, cex=2)
points(3.56, 82, pch=22, cex=2)
#dev.off()


##
## Now consider how perception of reputation mediates approval for the president
## Mediation comparing Compromise to Not Engage
##
library(mediation)

## Test reputation mediation effect on Compromise
# Results reported in Table 2 of the appendix

#Subset data for Not Engage and Compromise
data2 <- subset(exper2[(exper2$Strategy==3 | exper2$Strategy==4) & exper2$t2.c0.dum==1, ])

data2$compromise <- ifelse(data2$Strategy==4, 1, 0)

set.seed(02138)
presRep.med.c <- lm(presRep ~ compromise + education + income + gender + polParty, data=data2)
presRep.dv.c <- lm(tot.approval ~ presRep + compromise + education + income + gender + polParty, data=data2)
presRep.med.b.c <- mediate(presRep.med.c, presRep.dv.c, treat="compromise", mediator="presRep", sims=1500)

summary(presRep.med.b.c) 
#ACME = 0.38 p<0.01, Proportion mediated = 0.58 p<0.01

#proud
set.seed(02138)
proud.med.c <- lm(proud ~ compromise + education + income + gender + polParty, data=data2)
proud.dv.c <- lm(tot.approval ~ proud + compromise + education + income + gender + polParty, data=data2)
proud.med.b.c <- mediate(proud.med.c, proud.dv.c, treat="compromise", mediator="proud", sims=1500)

summary(proud.med.b.c) 
# ACME 0.27 p < 0.01, prop. med. .42 p < 0.01 

#worried
set.seed(02138)
worry.med.c <- lm(worry ~ compromise + education + income + gender + polParty, data=data2)
worry.dv.c <- lm(tot.approval ~ worry + compromise + education + income + gender + polParty, data=data2)
worry.med.b.c <- mediate(worry.med.c, worry.dv.c, treat="compromise", mediator="worry", sims=1500)

summary(worry.med.b.c) 
# ACME 0.19 p < 0.01, prop. med. .30 p < 0.01 

#frightened
set.seed(02138)
frightened.med.c <- lm(frightened ~ compromise + education + income + gender + polParty, data=data2)
frightened.dv.c <- lm(tot.approval ~ frightened + compromise + education + income + gender + polParty, data=data2)
frightened.med.b.c <- mediate(frightened.med.c, frightened.dv.c, treat="compromise", mediator="frightened", sims=1500)

summary(frightened.med.b.c)
# ACME 0.13 p < 0.01, prop. med. .20 p < 0.01 

#angry
set.seed(02138)
angry.med.c <- lm(angry ~ compromise + education + income + gender + polParty, data=data2)
angry.dv.c <- lm(tot.approval ~ angry + compromise + education + income + gender + polParty, data=data2)
angry.med.b.c <- mediate(angry.med.c, angry.dv.c, treat="compromise", mediator="angry", sims=1500)

summary(angry.med.b.c)
# ACME 0.27 p < 0.01, prop. med. .42 p < 0.01 

#hopeful
set.seed(02138)
hopeful.med.c <- lm(hopeful ~ compromise + education + income + gender + polParty, data=data2)
hopeful.dv.c <- lm(tot.approval ~ hopeful + compromise + education + income + gender + polParty, data=data2)
hopeful.med.b.c <- mediate(hopeful.med.c, hopeful.dv.c, treat="compromise", mediator="hopeful", sims=1500)

summary(hopeful.med.b.c)
# ACME 0.26 p < 0.01, prop. med. .40 p < 0.01 



